aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/bootloader/grub.scm19
-rw-r--r--gnu/build/file-systems.scm4
-rw-r--r--gnu/build/marionette.scm27
-rw-r--r--gnu/build/svg.scm11
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/packages/build-tools.scm2
-rw-r--r--gnu/packages/display-managers.scm4
-rw-r--r--gnu/packages/emacs.scm205
-rw-r--r--gnu/packages/gnuzilla.scm12
-rw-r--r--gnu/packages/haskell.scm160
-rw-r--r--gnu/packages/messaging.scm4
-rw-r--r--gnu/packages/patches/sddm-fix-build-with-qt-5.11-1024.patch28
-rw-r--r--gnu/packages/python.scm23
-rw-r--r--gnu/packages/qt.scm10
-rw-r--r--gnu/packages/rust.scm62
-rw-r--r--gnu/packages/version-control.scm129
-rw-r--r--gnu/packages/web.scm81
-rw-r--r--gnu/services/web.scm72
-rw-r--r--gnu/system.scm4
-rw-r--r--gnu/system/vm.scm95
-rw-r--r--gnu/tests/dict.scm19
-rw-r--r--gnu/tests/ssh.scm290
-rw-r--r--gnu/tests/web.scm82
23 files changed, 1003 insertions, 341 deletions
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index eca6d97b19..a131f3b506 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -121,25 +121,14 @@ otherwise."
(define* (svg->png svg #:key width height)
"Build a PNG of HEIGHT x WIDTH from SVG."
- ;; Note: Guile-RSVG & co. are now built for Guile 2.2, so we use 2.2 here.
- ;; TODO: Remove #:guile-for-build when 2.2 has become the default.
- (mlet %store-monad ((guile (package->derivation guile-2.2 #:graft? #f)))
- (gexp->derivation "grub-image.png"
- (with-imported-modules '((gnu build svg))
+ (gexp->derivation "grub-image.png"
+ (with-imported-modules '((gnu build svg))
+ (with-extensions (list guile-rsvg guile-cairo)
#~(begin
- ;; We need these two libraries.
- (add-to-load-path (string-append #+guile-rsvg
- "/share/guile/site/"
- (effective-version)))
- (add-to-load-path (string-append #+guile-cairo
- "/share/guile/site/"
- (effective-version)))
-
(use-modules (gnu build svg))
(svg->png #+svg #$output
#:width #$width
- #:height #$height)))
- #:guile-for-build guile)))
+ #:height #$height))))))
(define* (grub-background-image config #:key (width 1024) (height 768))
"Return the GRUB background image defined in CONFIG with a ratio of
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 3dd7358fd3..3f97afeedd 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -499,8 +499,8 @@ were found."
(match spec
((? string?)
- ;; Nothing to do.
- spec)
+ ;; Nothing to do, but wait until SPEC shows up.
+ (resolve identity spec identity))
((? file-system-label?)
;; Resolve the label.
(resolve find-partition-by-label
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 173a67cef9..bb018fc9c1 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -26,6 +26,7 @@
make-marionette
marionette-eval
wait-for-file
+ wait-for-tcp-port
marionette-control
marionette-screen-text
wait-for-screen-text
@@ -187,6 +188,32 @@ FILE has not shown up after TIMEOUT seconds, raise an error."
('failure
(error "file didn't show up" file))))
+(define* (wait-for-tcp-port port marionette
+ #:key (timeout 20))
+ "Wait for up to TIMEOUT seconds for PORT to accept connections in
+MARIONETTE. Raise an error on failure."
+ ;; Note: The 'connect' loop has to run within the guest because, when we
+ ;; forward ports to the host, connecting to the host never raises
+ ;; ECONNREFUSED.
+ (match (marionette-eval
+ `(begin
+ (let ((sock (socket PF_INET SOCK_STREAM 0)))
+ (let loop ((i 0))
+ (catch 'system-error
+ (lambda ()
+ (connect sock AF_INET INADDR_LOOPBACK ,port)
+ 'success)
+ (lambda args
+ (if (< i ,timeout)
+ (begin
+ (sleep 1)
+ (loop (+ 1 i)))
+ 'failure))))))
+ marionette)
+ ('success #t)
+ ('failure
+ (error "nobody's listening on port" port))))
+
(define (marionette-control command marionette)
"Run COMMAND in the QEMU monitor of MARIONETTE. COMMAND is a string such as
\"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(qemu-doc)
diff --git a/gnu/build/svg.scm b/gnu/build/svg.scm
index b5474ec4a0..6f1f4b3684 100644
--- a/gnu/build/svg.scm
+++ b/gnu/build/svg.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;;
;;; This file is part of GNU Guix.
@@ -18,16 +18,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build svg)
+ #:use-module (rsvg)
+ #:use-module (cairo)
#:use-module (srfi srfi-11)
#:export (svg->png))
-;; We need Guile-RSVG and Guile-Cairo. Load them lazily, at run time, to
-;; allow compilation to proceed. See also <http://bugs.gnu.org/12202>.
-(module-autoload! (current-module)
- '(rsvg) '(rsvg-handle-new-from-file))
-(module-autoload! (current-module)
- '(cairo) '(cairo-image-surface-create))
-
(define* (downscaled-surface surface
#:key
source-width source-height
diff --git a/gnu/local.mk b/gnu/local.mk
index 2e266af44d..a22f42843b 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1092,6 +1092,7 @@ dist_patch_DATA = \
%D%/packages/patches/scotch-build-parallelism.patch \
%D%/packages/patches/scotch-graph-diam-64.patch \
%D%/packages/patches/scotch-graph-induce-type-64.patch \
+ %D%/packages/patches/sddm-fix-build-with-qt-5.11-1024.patch \
%D%/packages/patches/sdl-libx11-1.6.patch \
%D%/packages/patches/seq24-rename-mutex.patch \
%D%/packages/patches/sharutils-CVE-2018-1000097.patch \
diff --git a/gnu/packages/build-tools.scm b/gnu/packages/build-tools.scm
index 4b078e78ed..a6d9fa8cfc 100644
--- a/gnu/packages/build-tools.scm
+++ b/gnu/packages/build-tools.scm
@@ -87,6 +87,8 @@ makes a few sacrifices to acquire fast full and incremental build times.")
(base32
"1m0w0wqnz983l7fpp5p9pdsqr7n3ybrzp8ywjcvn0rihsrzj65j6"))))
(build-system cmake-build-system)
+ (inputs
+ `(("python" ,python-wrapper)))
(home-page "https://github.com/rizsotto/Bear")
(synopsis "Tool for generating a compilation database")
(description "A JSON compilation database is used in the Clang project to
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index 6e3d4912de..b0ad3df788 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2018 Stefan Stefanović <stefanx2ovic@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -143,7 +144,8 @@ Qt-style API for Wayland clients.")
"sddm-" version ".tar.xz"))
(sha256
(base32
- "0ch6rdppgy2vbzw0c2x9a4c6ry46vx7p6b76d8xbh2nvxh23xv0k"))))
+ "0ch6rdppgy2vbzw0c2x9a4c6ry46vx7p6b76d8xbh2nvxh23xv0k"))
+ (patches (search-patches "sddm-fix-build-with-qt-5.11-1024.patch"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm
index 9c799aeffe..02d597d82c 100644
--- a/gnu/packages/emacs.scm
+++ b/gnu/packages/emacs.scm
@@ -751,77 +751,91 @@ provides an optional IDE-like error list.")
;;;
(define-public emacs-w3m
- (package
- (name "emacs-w3m")
- (version "1.4.538+0.20141022")
- (source (origin
- (method url-fetch)
- (uri (string-append "mirror://debian/pool/main/w/w3m-el/w3m-el_"
- version ".orig.tar.gz"))
- (sha256
- (base32
- "0zfxmq86pwk64yv0426gnjrvhjrgrjqn08sdcdhmmjmfpmqvm79y"))))
- (build-system gnu-build-system)
- (native-inputs `(("autoconf" ,autoconf)
- ("emacs" ,emacs-minimal)))
- (inputs `(("w3m" ,w3m)
- ("imagemagick" ,imagemagick)))
- (arguments
- `(#:modules ((guix build gnu-build-system)
- (guix build utils)
- (guix build emacs-utils))
- #:imported-modules (,@%gnu-build-system-modules
- (guix build emacs-utils))
- #:configure-flags
- (let ((out (assoc-ref %outputs "out")))
- (list (string-append "--with-lispdir="
- out "/share/emacs/site-lisp")
- (string-append "--with-icondir="
- out "/share/images/emacs-w3m")
- ;; Leave .el files uncompressed, otherwise GC can't
- ;; identify run-time dependencies. See
- ;; <http://lists.gnu.org/archive/html/guix-devel/2015-12/msg00208.html>
- "--without-compress-install"))
- #:tests? #f ; no check target
- #:phases
- (modify-phases %standard-phases
- (add-after 'unpack 'autoconf
- (lambda _
- (zero? (system* "autoconf"))))
- (add-before 'build 'patch-exec-paths
- (lambda* (#:key inputs outputs #:allow-other-keys)
- (let ((out (assoc-ref outputs "out"))
- (w3m (assoc-ref inputs "w3m"))
- (imagemagick (assoc-ref inputs "imagemagick"))
- (coreutils (assoc-ref inputs "coreutils")))
- (emacs-substitute-variables "w3m.el"
- ("w3m-command" (string-append w3m "/bin/w3m"))
- ("w3m-touch-command"
- (string-append coreutils "/bin/touch"))
- ("w3m-image-viewer"
- (string-append imagemagick "/bin/display"))
- ("w3m-icon-directory"
- (string-append out "/share/images/emacs-w3m")))
- (emacs-substitute-variables "w3m-image.el"
- ("w3m-imagick-convert-program"
- (string-append imagemagick "/bin/convert"))
- ("w3m-imagick-identify-program"
- (string-append imagemagick "/bin/identify")))
- #t)))
- (replace 'install
- (lambda* (#:key outputs #:allow-other-keys)
- (and (zero? (system* "make" "install" "install-icons"))
- (with-directory-excursion
- (string-append (assoc-ref outputs "out")
- "/share/emacs/site-lisp")
- (for-each delete-file '("ChangeLog" "ChangeLog.1"))
- (symlink "w3m-load.el" "w3m-autoloads.el")
- #t)))))))
- (home-page "http://emacs-w3m.namazu.org/")
- (synopsis "Simple Web browser for Emacs based on w3m")
- (description
- "Emacs-w3m is an emacs interface for the w3m web browser.")
- (license license:gpl2+)))
+ ;; Emacs-w3m follows a "rolling release" model from its CVS repo. We could
+ ;; use CVS, sure, but instead we choose to use this Git mirror described on
+ ;; the home page as an "unofficial" mirror.
+ (let ((commit "0dd5691f46d314a84da63f3a7277d721815811a2"))
+ (package
+ (name "emacs-w3m")
+ (version (git-version "1.5" "0" commit))
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/ecbrown/emacs-w3m")
+ (commit commit)))
+ (sha256
+ (base32
+ "02xalyxbrkgl4n8nj7xxkmsbm6lshhwdc8bzs2l4wz3hkpgkj7x4"))))
+ (build-system gnu-build-system)
+ (native-inputs `(("autoconf" ,autoconf)
+ ("texinfo" ,texinfo)
+ ("emacs" ,emacs-minimal)))
+ (inputs `(("w3m" ,w3m)
+ ("imagemagick" ,imagemagick)))
+ (arguments
+ `(#:modules ((guix build gnu-build-system)
+ (guix build utils)
+ (guix build emacs-utils))
+ #:imported-modules (,@%gnu-build-system-modules
+ (guix build emacs-utils))
+ #:configure-flags
+ (let ((out (assoc-ref %outputs "out")))
+ (list (string-append "--with-lispdir="
+ out "/share/emacs/site-lisp")
+ (string-append "--with-icondir="
+ out "/share/images/emacs-w3m")
+ ;; Leave .el files uncompressed, otherwise GC can't
+ ;; identify run-time dependencies. See
+ ;; <http://lists.gnu.org/archive/html/guix-devel/2015-12/msg00208.html>
+ "--without-compress-install"))
+ #:tests? #f ; no check target
+ #:phases
+ (modify-phases %standard-phases
+ (add-after 'unpack 'autoconf
+ (lambda _
+ (zero? (system* "autoconf"))))
+ (add-before 'configure 'support-emacs!
+ (lambda _
+ ;; For some reason 'AC_PATH_EMACS' thinks that 'Emacs 26' is
+ ;; unsupported.
+ (substitute* "configure"
+ (("EMACS_FLAVOR=unsupported")
+ "EMACS_FLAVOR=emacs"))
+ #t))
+ (add-before 'build 'patch-exec-paths
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (let ((out (assoc-ref outputs "out"))
+ (w3m (assoc-ref inputs "w3m"))
+ (imagemagick (assoc-ref inputs "imagemagick"))
+ (coreutils (assoc-ref inputs "coreutils")))
+ (make-file-writable "w3m.el")
+ (emacs-substitute-variables "w3m.el"
+ ("w3m-command" (string-append w3m "/bin/w3m"))
+ ("w3m-touch-command"
+ (string-append coreutils "/bin/touch"))
+ ("w3m-icon-directory"
+ (string-append out "/share/images/emacs-w3m")))
+ (make-file-writable "w3m-image.el")
+ (emacs-substitute-variables "w3m-image.el"
+ ("w3m-imagick-convert-program"
+ (string-append imagemagick "/bin/convert"))
+ ("w3m-imagick-identify-program"
+ (string-append imagemagick "/bin/identify")))
+ #t)))
+ (replace 'install
+ (lambda* (#:key outputs #:allow-other-keys)
+ (and (zero? (system* "make" "install" "install-icons"))
+ (with-directory-excursion
+ (string-append (assoc-ref outputs "out")
+ "/share/emacs/site-lisp")
+ (for-each delete-file '("ChangeLog" "ChangeLog.1"))
+ (symlink "w3m-load.el" "w3m-autoloads.el")
+ #t)))))))
+ (home-page "http://emacs-w3m.namazu.org/")
+ (synopsis "Simple Web browser for Emacs based on w3m")
+ (description
+ "Emacs-w3m is an emacs interface for the w3m web browser.")
+ (license license:gpl2+))))
(define-public emacs-wget
(package
@@ -10571,3 +10585,52 @@ well as take screenshots and lock your screen. The package depends on the
availability of shell commands to do the hard work for us. These commands can
be changed by customizing the appropriate variables.")
(license license:gpl3+)))
+
+(define-public emacs-org-caldav
+ (package
+ (name "emacs-org-caldav")
+ (version "20180403")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append
+ "https://github.com/dengste/org-caldav/raw/"
+ "8d3492c27a09f437d2d94f2736c56d7652e87aa0"
+ "/org-caldav.el"))
+ (sha256
+ (base32
+ "1fh4gh68ddj0is99z2ccyh97v6psnyda61n2dsadzqhcxn51amlc"))))
+ (build-system emacs-build-system)
+ (propagated-inputs `(("emacs-org" ,emacs-org)))
+ (home-page "https://github.com/dengste/org-caldav")
+ (synopsis
+ "Sync Org files with external calendars via the CalDAV protocol")
+ (description
+ "Synchronize between events in Org-mode files and a CalDAV calendar.
+This code is still alpha.")
+ (license license:gpl3+)))
+
+(define-public emacs-zotxt
+ (package
+ (name "emacs-zotxt")
+ (version "20180518")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append
+ "https://github.com/egh/zotxt-emacs/archive/"
+ "23a4a9f74a658222027d53a9a83cd4bcc583ca8b"
+ ".tar.gz"))
+ (sha256
+ (base32
+ "1qlibaciqgsva6fc7vv9krssjq00bi880396jk7llbi3c52q9n1y"))))
+ (build-system emacs-build-system)
+ (propagated-inputs
+ `(("emacs-deferred" ,emacs-deferred)
+ ("emacs-request" ,emacs-request)))
+ (home-page "https://github.com/egh/zotxt-emacs")
+ (synopsis "Integrate Emacs with Zotero")
+ (description "This package provides two integration features between Emacs
+and the Zotero research assistant: Insertion of links to Zotero items into an
+Org-mode file, and citations of Zotero items in Pandoc Markdown files.")
+ (license license:gpl3+)))
diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm
index cca0edbbf3..df87700d6f 100644
--- a/gnu/packages/gnuzilla.scm
+++ b/gnu/packages/gnuzilla.scm
@@ -489,7 +489,17 @@ security standards.")
(mozilla-patch "icecat-bug-1459206-pt2.patch" "9ad16112044a" "0ayya67sx7avcb8bplfdxb92l9g4mjrb1s3hby283llhqv0ikg9b")
(mozilla-patch "icecat-bug-1459162.patch" "11d8a87fb6d6" "1rkmdk18llw0x1jakix75hlhy0hpsmlminnflagbzrzjli81gwm1")
(mozilla-patch "icecat-bug-1451297.patch" "407b10ad1273" "16qzsfirw045xag96f1qvpdlibm8lwdj9l1mlli4n1vz0db91v9q")
- (mozilla-patch "icecat-bug-1462682.patch" "e76e2e481b17" "0hnx13msjy28n3bpa2c24kpzalam4bdk5gnp0f9k671l48rs9yb3")))
+ (mozilla-patch "icecat-bug-1462682.patch" "e76e2e481b17" "0hnx13msjy28n3bpa2c24kpzalam4bdk5gnp0f9k671l48rs9yb3")
+ (mozilla-patch "icecat-bug-1450688.patch" "2c75bfcd465c" "1pjinj8qypafqm2fk68s3hzcbzcijn09qzrpcxvzq6bl1yfc1xfd")
+ (mozilla-patch "icecat-bug-1456975.patch" "042f80f3befd" "0av918kin4bkrq7gnjz0h9w8kkq8rk9l93250lfl5kqrinza1gsk")
+ (mozilla-patch "icecat-bugs-1442722+1455071+1433642+1456604+1458320.patch"
+ "bb0451c9c4a0" "1lhm1b2a7c6jwhzsg3c830hfhp17p8j9zbcmgchpb8c5jkc3vw0x")
+ (mozilla-patch "icecat-bug-1465108-pt1.patch" "8189b262e3b9" "13rh86ddwmj1bhv3ibbil3sv5xbqq1c9v1czgbsna5hxxkzc1y3b")
+ (mozilla-patch "icecat-bug-1465108-pt2.patch" "9f81ae3f6e1d" "05vfg8a8jrzd93n1wvncmvdmqgf9cgsl8ryxgjs3032gbbjkga7q")
+ (mozilla-patch "icecat-bug-1459693.patch" "face7a3dd5d7" "0jclw30mf693w8lrmvn0iankggj21nh4j3zh51q5363rj5xncdzx")
+ (mozilla-patch "icecat-bug-1464829.patch" "7afb58c046c8" "1r0569r76712x7x1sw6xr0x06ilv6iw3fncb0f8r8b9mp6wrpx34")
+ (mozilla-patch "icecat-bug-1452375-pt1.patch" "f1a745f8c42d" "11q73pb7a8f09xjzil4rhg5nr49zrnz1vb0prni0kqvrnppf5s40")
+ (mozilla-patch "icecat-bug-1452375-pt2.patch" "1f9a430881cc" "0f79rv7njliqxx33z07n60b50jg0a596d1km7ayz2hivbl2d0168")))
(modules '((guix build utils)))
(snippet
'(begin
diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm
index 83e71ce869..2176f07cc4 100644
--- a/gnu/packages/haskell.scm
+++ b/gnu/packages/haskell.scm
@@ -14,6 +14,7 @@
;;; Copyright © 2017 rsiddharth <s@ricketyspace.net>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Tonton <tonton@riseup.net>
+;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1940,6 +1941,30 @@ case with other forms of concurrent communication, such as locks or
"This package provides a library for parallel programming.")
(license license:bsd-3)))
+(define-public ghc-safesemaphore
+ (package
+ (name "ghc-safesemaphore")
+ (version "0.10.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://hackage.haskell.org/package/"
+ "SafeSemaphore/SafeSemaphore-" version ".tar.gz"))
+ (sha256
+ (base32
+ "0rpg9j6fy70i0b9dkrip9d6wim0nac0snp7qzbhykjkqlcvvgr91"))))
+ (build-system haskell-build-system)
+ (inputs
+ `(("ghc-stm" ,ghc-stm)))
+ (native-inputs
+ `(("ghc-hunit" ,ghc-hunit)))
+ (home-page "https://github.com/ChrisKuklewicz/SafeSemaphore")
+ (synopsis "Exception safe semaphores")
+ (description "This library provides exception safe semaphores that can be
+used in place of @code{QSem}, @code{QSemN}, and @code{SampleVar}, all of which
+are not exception safe and can be broken by @code{killThread}.")
+ (license license:bsd-3)))
+
(define-public ghc-text
(package
(name "ghc-text")
@@ -2990,6 +3015,35 @@ online}.")
(description "This package provides a simple XML library for Haskell.")
(license license:bsd-3)))
+(define-public ghc-feed
+ (package
+ (name "ghc-feed")
+ (version "0.3.12.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://hackage.haskell.org/package/"
+ "feed/feed-" version ".tar.gz"))
+ (sha256
+ (base32
+ "0hkrsinspg70bbm3hwqdrvivws6zya1hyk0a3awpaz82j4xnlbfc"))))
+ (build-system haskell-build-system)
+ (inputs
+ `(("ghc-old-locale" ,ghc-old-locale)
+ ("ghc-old-time" ,ghc-old-time)
+ ("ghc-time-locale-compat" ,ghc-time-locale-compat)
+ ("ghc-utf8-string" ,ghc-utf8-string)
+ ("ghc-xml" ,ghc-xml)))
+ (native-inputs
+ `(("ghc-hunit" ,ghc-hunit)
+ ("ghc-test-framework" ,ghc-test-framework)
+ ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)))
+ (home-page "https://github.com/bergmark/feed")
+ (synopsis "Haskell package for handling various syndication formats")
+ (description "This Haskell package includes tools for generating and
+consuming feeds in both RSS (Really Simple Syndication) and Atom format.")
+ (license license:bsd-3)))
+
(define-public ghc-exceptions
(package
(name "ghc-exceptions")
@@ -3575,6 +3629,31 @@ vector types are supported. Specific instances are provided for unboxed,
boxed and storable vectors.")
(license license:bsd-3)))
+(define-public ghc-bloomfilter
+ (package
+ (name "ghc-bloomfilter")
+ (version "2.0.1.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://hackage.haskell.org/package/"
+ "bloomfilter/bloomfilter-" version ".tar.gz"))
+ (sha256
+ (base32
+ "03vrmncg1c10a2wcg5skq30m1yiknn7nwxz2gblyyfaxglshspkc"))))
+ (build-system haskell-build-system)
+ (native-inputs
+ `(("ghc-quickcheck" ,ghc-quickcheck)
+ ("ghc-random" ,ghc-random)
+ ("ghc-test-framework" ,ghc-test-framework)
+ ("ghc-test-framework-quickcheck2" ,ghc-test-framework-quickcheck2)))
+ (home-page "https://github.com/bos/bloomfilter")
+ (synopsis "Pure and impure Bloom filter implementations")
+ (description "This package provides both mutable and immutable Bloom
+filter data types, along with a family of hash functions and an easy-to-use
+interface.")
+ (license license:bsd-3)))
+
(define-public ghc-network
(package
(name "ghc-network")
@@ -3760,6 +3839,27 @@ with various performance characteristics.")
manipulating monad transformer stacks.")
(license license:bsd-3)))
+(define-public ghc-ifelse
+ (package
+ (name "ghc-ifelse")
+ (version "0.85")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://hackage.haskell.org/package/"
+ "IfElse/IfElse-" version ".tar.gz"))
+ (sha256
+ (base32
+ "1kfx1bwfjczj93a8yqz1n8snqiq5655qgzwv1lrycry8wb1vzlwa"))))
+ (build-system haskell-build-system)
+ (inputs `(("ghc-mtl" ,ghc-mtl)))
+ (home-page "http://hackage.haskell.org/package/IfElse")
+ (synopsis "Monadic control flow with anaphoric variants")
+ (description "This library provides functions for control flow inside of
+monads with anaphoric variants on @code{if} and @code{when} and a C-like
+@code{switch} function.")
+ (license license:bsd-3)))
+
(define-public ghc-monad-control
(package
(name "ghc-monad-control")
@@ -7738,6 +7838,44 @@ converting between Haskell values and JSON.
JSON (JavaScript Object Notation) is a lightweight data-interchange format.")
(license license:bsd-3)))
+(define-public ghc-esqueleto
+ (package
+ (name "ghc-esqueleto")
+ (version "2.5.3")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://hackage.haskell.org/package/"
+ "esqueleto/esqueleto-" version ".tar.gz"))
+ (sha256
+ (base32
+ "10n49rzqmblky7pwjnysalyy6nacmxfms8dqbsdv6hlyzr8pb69x"))))
+ (build-system haskell-build-system)
+ (inputs
+ `(("ghc-blaze-html" ,ghc-blaze-html)
+ ("ghc-conduit" ,ghc-conduit)
+ ("ghc-monad-logger" ,ghc-monad-logger)
+ ("ghc-persistent" ,ghc-persistent)
+ ("ghc-resourcet" ,ghc-resourcet)
+ ("ghc-tagged" ,ghc-tagged)
+ ("ghc-text" ,ghc-text)
+ ("ghc-unordered-containers" ,ghc-unordered-containers)))
+ (native-inputs
+ `(("ghc-hspec" ,ghc-hspec)
+ ("ghc-hunit" ,ghc-hunit)
+ ("ghc-monad-control" ,ghc-monad-control)
+ ("ghc-persistent-sqlite" ,ghc-persistent-sqlite)
+ ("ghc-persistent-template" ,ghc-persistent-template)
+ ("ghc-quickcheck" ,ghc-quickcheck)))
+ (home-page "https://github.com/bitemyapp/esqueleto")
+ (synopsis "Type-safe embedded domain specific language for SQL queries")
+ (description "This library provides a type-safe embedded domain specific
+language (EDSL) for SQL queries that works with SQL backends as provided by
+@code{ghc-persistent}. Its language closely resembles SQL, so you don't have
+to learn new concepts, just new syntax, and it's fairly easy to predict the
+generated SQL and optimize it for your backend.")
+ (license license:bsd-3)))
+
(define-public shellcheck
(package
(name "shellcheck")
@@ -7836,6 +7974,8 @@ bytestrings and their hexademical representation.")
(base32
"0n39s1i88j6s7vvsdhpbhcr3gpbwlzabwcc3nbd7nqb4kb4i0sls"))))
(build-system haskell-build-system)
+ (arguments
+ `(#:configure-flags (list "--allow-newer=QuickCheck")))
(inputs
`(("ghc-hashable" ,ghc-hashable)))
(native-inputs
@@ -9518,4 +9658,24 @@ serialization code.")
(home-page "https://hackage.haskell.org/package/bytes")
(license license:bsd-3)))
+(define-public ghc-disk-free-space
+ (package
+ (name "ghc-disk-free-space")
+ (version "0.1.0.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://hackage.haskell.org/package/"
+ "disk-free-space/disk-free-space-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "07rqj8k1vh3cykq9yidpjxhgh1f7vgmjs6y1nv5kq2217ff4yypi"))))
+ (build-system haskell-build-system)
+ (home-page "https://github.com/redneb/disk-free-space")
+ (synopsis "Retrieve information about disk space usage")
+ (description "A cross-platform library for retrieving information about
+disk space usage.")
+ (license license:bsd-3)))
+
;;; haskell.scm ends here
diff --git a/gnu/packages/messaging.scm b/gnu/packages/messaging.scm
index 407d7ee317..e098a8b37e 100644
--- a/gnu/packages/messaging.scm
+++ b/gnu/packages/messaging.scm
@@ -736,14 +736,14 @@ a graphical desktop environment like GNOME.")
(define-public prosody
(package
(name "prosody")
- (version "0.10.1")
+ (version "0.10.2")
(source (origin
(method url-fetch)
(uri (string-append "https://prosody.im/downloads/source/"
"prosody-" version ".tar.gz"))
(sha256
(base32
- "1kmmpkkgymg1r8r0k8j83pgmiskg1phl8hmpzjrnvlvsfnrnjplr"))))
+ "13knr7izscw0zx648b9582dx11aap4cq9bzfiqh5ykd7wwsz1dbm"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no "check" target
diff --git a/gnu/packages/patches/sddm-fix-build-with-qt-5.11-1024.patch b/gnu/packages/patches/sddm-fix-build-with-qt-5.11-1024.patch
new file mode 100644
index 0000000000..53c184230a
--- /dev/null
+++ b/gnu/packages/patches/sddm-fix-build-with-qt-5.11-1024.patch
@@ -0,0 +1,28 @@
+diff --git a/CMakeLists.txt b/CMakeLists.txt
+index 2efc649..8903b52 100644
+--- a/CMakeLists.txt
++++ b/CMakeLists.txt
+@@ -93,7 +95,7 @@
+ find_package(XKB REQUIRED)
+
+ # Qt 5
+-find_package(Qt5 5.6.0 CONFIG REQUIRED Core DBus Gui Qml Quick LinguistTools)
++find_package(Qt5 5.8.0 CONFIG REQUIRED Core DBus Gui Qml Quick LinguistTools Test)
+
+ # find qt5 imports dir
+ get_target_property(QMAKE_EXECUTABLE Qt5::qmake LOCATION)
+diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt
+index c9d935a..bb85ddd 100644
+--- a/test/CMakeLists.txt
++++ b/test/CMakeLists.txt
+@@ -2,9 +2,8 @@
+
+ include_directories(../src/common)
+
+-
+ set(ConfigurationTest_SRCS ConfigurationTest.cpp ../src/common/ConfigReader.cpp)
+ add_executable(ConfigurationTest ${ConfigurationTest_SRCS})
+ add_test(NAME Configuration COMMAND ConfigurationTest)
+
+-qt5_use_modules(ConfigurationTest Test)
++target_link_libraries(ConfigurationTest Qt5::Core Qt5::Test)
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index 86ddb4c6df..52d4bb2a7b 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -5243,6 +5243,29 @@ more advanced mathematics.")
(define-public python2-mpmath
(package-with-python2 python-mpmath))
+(define-public python-bigfloat
+ (package
+ (name "python-bigfloat")
+ (version "0.3.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (pypi-uri "bigfloat" version))
+ (sha256
+ (base32 "0xd7q4l7v0f463diznjv4k9wlaks80pn9drdqmfifi7zx8qvybi6"))))
+ (build-system python-build-system)
+ (inputs
+ `(("mpfr" ,mpfr)))
+ (home-page "https://github.com/mdickinson/bigfloat")
+ (synopsis "Arbitrary precision floating-point arithmetic for Python")
+ (description
+ "This packages provides a Python interface to the MPFR library for
+multiprecision arithmetic.")
+ (license license:lgpl3+)))
+
+(define-public python2-bigfloat
+ (package-with-python2 python-bigfloat))
+
(define-public python-sympy
(package
(name "python-sympy")
diff --git a/gnu/packages/qt.scm b/gnu/packages/qt.scm
index 309fcc46ca..020cccd04d 100644
--- a/gnu/packages/qt.scm
+++ b/gnu/packages/qt.scm
@@ -489,6 +489,16 @@ developers using C++ or QML, a CSS & JavaScript like language.")
out "/share/doc/qt5/examples")
"-opensource"
"-confirm-license"
+
+ ;; These features require higher versions of Linux than the
+ ;; minimum version of the glibc. See
+ ;; src/corelib/global/minimum-linux_p.h. By disabling these
+ ;; features Qt5 applications can be used on the oldest
+ ;; kernels that the glibc supports, including the RHEL6
+ ;; (2.6.32) and RHEL7 (3.10) kernels.
+ "-no-feature-getentropy" ; requires Linux 3.17
+ "-no-feature-renameat2" ; requires Linux 3.16
+
;; Do not build examples; if desired, these could go
;; into a separate output, but for the time being, we
;; prefer to save the space and build time.
diff --git a/gnu/packages/rust.scm b/gnu/packages/rust.scm
index 51d4f6c040..62b5ee5ffa 100644
--- a/gnu/packages/rust.scm
+++ b/gnu/packages/rust.scm
@@ -63,32 +63,34 @@
(package
(name "rust-bootstrap")
(version "1.22.1")
- (source (origin
- (method url-fetch)
- (uri (string-append
- "https://static.rust-lang.org/dist/"
- "rust-" version "-" %host-type ".tar.gz"))
- (sha256
- (base32
- (match %host-type
- ("i686-unknown-linux-gnu"
- "15zqbx86nm13d5vq2gm69b7av4vg479f74b5by64hs3bcwwm08pr")
- ("x86_64-unknown-linux-gnu"
- "1yll78x6b3abnvgjf2b66gvp6mmcb9y9jdiqcwhmgc0z0i0fix4c")
- ("armv7-unknown-linux-gnueabihf"
- "138a8l528kzp5wyk1mgjaxs304ac5ms8vlpq0ggjaznm6bn2j7a5")
- ("aarch64-unknown-linux-gnu"
- "0z6m9m1rx4d96nvybbfmpscq4dv616m615ijy16d5wh2vx0p4na8")
- ("mips64el-unknown-linux-gnuabi64"
- "07k4pcv7jvfa48cscdj8752lby7m7xdl88v3a6na1vs675lhgja2")
- (_ ""))))))
+ (source #f)
(build-system gnu-build-system)
(native-inputs
`(("patchelf" ,patchelf)))
(inputs
`(("gcc" ,(canonical-package gcc))
("gcc:lib" ,(canonical-package gcc) "lib")
- ("zlib" ,zlib)))
+ ("zlib" ,zlib)
+ ("source"
+ ,(origin
+ (method url-fetch)
+ (uri (string-append
+ "https://static.rust-lang.org/dist/"
+ "rust-" version "-" (nix-system->gnu-triplet) ".tar.gz"))
+ (sha256
+ (base32
+ (match (nix-system->gnu-triplet)
+ ("i686-unknown-linux-gnu"
+ "15zqbx86nm13d5vq2gm69b7av4vg479f74b5by64hs3bcwwm08pr")
+ ("x86_64-unknown-linux-gnu"
+ "1yll78x6b3abnvgjf2b66gvp6mmcb9y9jdiqcwhmgc0z0i0fix4c")
+ ("armv7-unknown-linux-gnueabihf"
+ "138a8l528kzp5wyk1mgjaxs304ac5ms8vlpq0ggjaznm6bn2j7a5")
+ ("aarch64-unknown-linux-gnu"
+ "0z6m9m1rx4d96nvybbfmpscq4dv616m615ijy16d5wh2vx0p4na8")
+ ("mips64el-unknown-linux-gnuabi64"
+ "07k4pcv7jvfa48cscdj8752lby7m7xdl88v3a6na1vs675lhgja2")
+ (_ ""))))))))
(outputs '("out" "cargo"))
(arguments
`(#:tests? #f
@@ -117,7 +119,7 @@
(invoke "bash" "install.sh"
(string-append "--prefix=" out)
(string-append "--components=rustc,"
- "rust-std-" %host-type))
+ "rust-std-" ,(nix-system->gnu-triplet)))
;; Instal cargo
(invoke "bash" "install.sh"
(string-append "--prefix=" cargo-out)
@@ -196,6 +198,12 @@ in turn be used to build the final Rust.")
;; This test is known to fail on aarch64 and powerpc64le:
;; https://github.com/rust-lang/rust/issues/45410
(("fn test_loading_cosine") "#[ignore]\nfn test_loading_cosine"))
+ ;; nm doesn't recognize the file format because of the
+ ;; nonstandard sections used by the Rust compiler, but readelf
+ ;; ignores them.
+ (substitute* "src/test/run-make/atomic-lock-free/Makefile"
+ (("\tnm ")
+ "\treadelf -c "))
#t)))
(add-after 'patch-source-shebangs 'patch-cargo-checksums
(lambda* _
@@ -386,6 +394,10 @@ safety and thread safety guarantees.")
(substitute* "src/tools/cargo/tests/death.rs"
;; This is stuck when built in container.
(("fn ctrl_c_kills_everyone") "#[ignore]\nfn ctrl_c_kills_everyone"))
+ ;; Prints test output in the wrong order when built on
+ ;; i686-linux.
+ (substitute* "src/tools/cargo/tests/test.rs"
+ (("fn cargo_test_env") "#[ignore]\nfn cargo_test_env"))
#t))
(add-after 'patch-cargo-tests 'fix-mtime-bug
(lambda* _
@@ -433,7 +445,7 @@ rpath = true
# codegen/mainsubprogram.rs and codegen/mainsubprogramstart.rs
# This tests required patched LLVM
codegen-tests = false
-[target." %host-type "]
+[target." ,(nix-system->gnu-triplet) "]
llvm-config = \"" llvm "/bin/llvm-config" "\"
cc = \"" gcc "/bin/gcc" "\"
cxx = \"" gcc "/bin/g++" "\"
@@ -456,8 +468,10 @@ jemalloc = \"" jemalloc "/lib/libjemalloc_pic.a" "\"
(invoke "./x.py" "build" "src/tools/cargo")))
(replace 'check
(lambda* _
- (invoke "./x.py" "test")
- (invoke "./x.py" "test" "src/tools/cargo")))
+ ;; Disable parallel execution to prevent EAGAIN errors when
+ ;; running tests.
+ (invoke "./x.py" "-j1" "test")
+ (invoke "./x.py" "-j1" "test" "src/tools/cargo")))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "./x.py" "install")
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 3a2975ee75..5487298929 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -84,6 +85,7 @@
#:use-module (gnu packages python)
#:use-module (gnu packages python-web)
#:use-module (gnu packages readline)
+ #:use-module (gnu packages rsync)
#:use-module (gnu packages databases)
#:use-module (gnu packages admin)
#:use-module (gnu packages xml)
@@ -1993,3 +1995,130 @@ venerable RCS, hence the anagrammatic acronym. The design is tuned for use
cases like all those little scripts in your @file{~/bin} directory, or a
directory full of HOWTOs.")
(license license:bsd-2)))
+
+(define-public git-annex
+ (package
+ (name "git-annex")
+ (version "6.20170818")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://hackage.haskell.org/package/"
+ "git-annex/git-annex-" version ".tar.gz"))
+ (sha256
+ (base32
+ "0ybxixbqvy4rx6mq9s02rh349rbr04hb17z4bfayin0qwa5kzpvx"))))
+ (build-system haskell-build-system)
+ (arguments
+ `(#:configure-flags
+ '("--flags=-Android -Assistant -Pairing -S3 -Webapp -WebDAV")
+ #:phases
+ (modify-phases %standard-phases
+ (add-before 'configure 'patch-shell
+ (lambda _
+ (substitute* "Utility/Shell.hs"
+ (("/bin/sh") (which "sh")))
+ #t))
+ (add-before 'configure 'factor-setup
+ (lambda _
+ ;; Factor out necessary build logic from the provided
+ ;; `Setup.hs' script. The script as-is does not work because
+ ;; it cannot find its dependencies, and there is no obvious way
+ ;; to tell it where to look. Note that we do not preserve the
+ ;; code that installs man pages here.
+ (call-with-output-file "PreConf.hs"
+ (lambda (out)
+ (format out "import qualified Build.Configure as Configure~%")
+ (format out "main = Configure.run Configure.tests~%")))
+ (call-with-output-file "Setup.hs"
+ (lambda (out)
+ (format out "import Distribution.Simple~%")
+ (format out "main = defaultMain~%")))
+ #t))
+ (add-before 'configure 'pre-configure
+ (lambda _
+ (invoke "runhaskell" "PreConf.hs")
+ #t))
+ (replace 'check
+ (lambda _
+ ;; We need to set the path so that Git recognizes
+ ;; `git annex' as a custom command.
+ (setenv "PATH" (string-append (getenv "PATH") ":"
+ (getcwd) "/dist/build/git-annex"))
+ (with-directory-excursion "dist/build/git-annex"
+ (symlink "git-annex" "git-annex-shell"))
+ (invoke "git-annex" "test")
+ #t))
+ (add-after 'install 'install-symlinks
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin")))
+ (symlink (string-append bin "/git-annex")
+ (string-append bin "/git-annex-shell"))
+ (symlink (string-append bin "/git-annex")
+ (string-append bin "/git-remote-tor-annex"))
+ #t))))))
+ (inputs
+ `(("curl" ,curl)
+ ("ghc-aeson" ,ghc-aeson)
+ ("ghc-async" ,ghc-async)
+ ("ghc-bloomfilter" ,ghc-bloomfilter)
+ ("ghc-byteable" ,ghc-byteable)
+ ("ghc-case-insensitive" ,ghc-case-insensitive)
+ ("ghc-crypto-api" ,ghc-crypto-api)
+ ("ghc-cryptonite" ,ghc-cryptonite)
+ ("ghc-data-default" ,ghc-data-default)
+ ("ghc-disk-free-space" ,ghc-disk-free-space)
+ ("ghc-dlist" ,ghc-dlist)
+ ("ghc-edit-distance" ,ghc-edit-distance)
+ ("ghc-esqueleto" ,ghc-esqueleto)
+ ("ghc-exceptions" ,ghc-exceptions)
+ ("ghc-feed" ,ghc-feed)
+ ("ghc-free" ,ghc-free)
+ ("ghc-hslogger" ,ghc-hslogger)
+ ("ghc-http-client" ,ghc-http-client)
+ ("ghc-http-conduit" ,ghc-http-conduit)
+ ("ghc-http-types" ,ghc-http-types)
+ ("ghc-ifelse" ,ghc-ifelse)
+ ("ghc-memory" ,ghc-memory)
+ ("ghc-monad-control" ,ghc-monad-control)
+ ("ghc-monad-logger" ,ghc-monad-logger)
+ ("ghc-mtl" ,ghc-mtl)
+ ("ghc-network" ,ghc-network)
+ ("ghc-old-locale" ,ghc-old-locale)
+ ("ghc-optparse-applicative" ,ghc-optparse-applicative)
+ ("ghc-persistent" ,ghc-persistent)
+ ("ghc-persistent-sqlite" ,ghc-persistent-sqlite)
+ ("ghc-persistent-template" ,ghc-persistent-template)
+ ("ghc-quickcheck" ,ghc-quickcheck)
+ ("ghc-random" ,ghc-random)
+ ("ghc-regex-tdfa" ,ghc-regex-tdfa)
+ ("ghc-resourcet" ,ghc-resourcet)
+ ("ghc-safesemaphore" ,ghc-safesemaphore)
+ ("ghc-sandi" ,ghc-sandi)
+ ("ghc-securemem" ,ghc-securemem)
+ ("ghc-socks" ,ghc-socks)
+ ("ghc-split" ,ghc-split)
+ ("ghc-stm" ,ghc-stm)
+ ("ghc-stm-chans" ,ghc-stm-chans)
+ ("ghc-text" ,ghc-text)
+ ("ghc-unix-compat" ,ghc-unix-compat)
+ ("ghc-unordered-containers" ,ghc-unordered-containers)
+ ("ghc-utf8-string" ,ghc-utf8-string)
+ ("ghc-uuid" ,ghc-uuid)
+ ("git" ,git)
+ ("rsync" ,rsync)))
+ (native-inputs
+ `(("ghc-tasty" ,ghc-tasty)
+ ("ghc-tasty-hunit" ,ghc-tasty-hunit)
+ ("ghc-tasty-quickcheck" ,ghc-tasty-quickcheck)
+ ("ghc-tasty-rerun" ,ghc-tasty-rerun)))
+ (home-page "https://git-annex.branchable.com/")
+ (synopsis "Manage files with Git, without checking in their contents")
+ (description "This package allows managing files with Git, without
+checking the file contents into Git. It can store files in many places,
+such as local hard drives and cloud storage services. It can also be
+used to keep a folder in sync between computers.")
+ ;; The web app is released under the AGPLv3+.
+ (license (list license:gpl3+
+ license:agpl3+))))
diff --git a/gnu/packages/web.scm b/gnu/packages/web.scm
index d9ce68ba51..5bb2b74e5d 100644
--- a/gnu/packages/web.scm
+++ b/gnu/packages/web.scm
@@ -25,6 +25,7 @@
;;; Copyright © 2017 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -82,6 +83,7 @@
#:use-module (gnu packages gnuzilla)
#:use-module (gnu packages gperf)
#:use-module (gnu packages gtk)
+ #:use-module (gnu packages guile)
#:use-module (gnu packages java)
#:use-module (gnu packages javascript)
#:use-module (gnu packages jemalloc)
@@ -96,6 +98,7 @@
#:use-module (gnu packages ncurses)
#:use-module (gnu packages openstack)
#:use-module (gnu packages base)
+ #:use-module (gnu packages package-management)
#:use-module (gnu packages perl)
#:use-module (gnu packages perl-check)
#:use-module (gnu packages python)
@@ -6424,3 +6427,81 @@ compressed JSON header blocks.
@item @command{inflatehd} converts such compressed headers back to JSON pairs.
@end itemize\n")
(license l:expat)))
+
+(define-public hpcguix-web
+ (let ((commit "3e3b9a3a406ee2dcd10c96cbedcc16ea378e8e8f"))
+ (package
+ (name "hpcguix-web")
+ (version (git-version "0.0.1" "0" commit))
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/UMCUGenetics/hpcguix-web.git")
+ (commit commit)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "01888byi9mh7d3adcmwhmg44kg98g92r44ilc4wd7an66mjnxpry"))))
+ (build-system gnu-build-system)
+ (arguments
+ `(#:modules ((guix build gnu-build-system)
+ (guix build utils)
+ (srfi srfi-26)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ #:phases
+ (modify-phases %standard-phases
+ (add-before 'configure 'autoconf
+ (lambda _
+ (setenv "GUILE_AUTO_COMPILE" "0")
+ (setenv "XDG_CACHE_HOME" (getcwd))
+ (invoke "autoreconf" "-vif")))
+ (add-after 'install 'wrap-program
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (guix (assoc-ref inputs "guix"))
+ (guile (assoc-ref inputs "guile"))
+ (json (assoc-ref inputs "guile-json"))
+ (guile-cm (assoc-ref inputs
+ "guile-commonmark"))
+ (deps (list guile guile-cm guix json))
+ (effective
+ (read-line
+ (open-pipe* OPEN_READ
+ (string-append guile "/bin/guile")
+ "-c" "(display (effective-version))")))
+ (path (string-join
+ (map (cut string-append <>
+ "/share/guile/site/"
+ effective)
+ deps)
+ ":"))
+ (gopath (string-join
+ (map (cut string-append <>
+ "/lib/guile/" effective
+ "/site-ccache")
+ deps)
+ ":")))
+ (wrap-program (string-append out "/bin/run")
+ `("GUILE_LOAD_PATH" ":" prefix (,path))
+ `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,gopath)))
+
+ #t))))))
+ (native-inputs
+ `(("autoconf" ,autoconf)
+ ("automake" ,automake)
+ ("uglify-js" ,uglify-js)
+ ("pkg-config" ,pkg-config)))
+ (inputs
+ `(("guix" ,guix)))
+ (propagated-inputs
+ `(("guile" ,guile-2.2)
+ ("guile-commonmark" ,guile-commonmark)
+ ("guile-json" ,guile-json)))
+ (home-page "https://github.com/UMCUGenetics/hpcguix-web")
+ (synopsis "Web interface for cluster deployments of Guix")
+ (description "Hpcguix-web provides a web interface to the list of packages
+provided by Guix. The list of packages is searchable and provides
+instructions on how to use Guix in a shared HPC environment.")
+ (license l:agpl3+))))
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index b336a8dd30..aae2f3db0d 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2017 nee <nee-git@hidamari.blue>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,11 +26,14 @@
(define-module (gnu services web)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
+ #:use-module (gnu system pam)
#:use-module (gnu system shadow)
#:use-module (gnu packages admin)
#:use-module (gnu packages web)
#:use-module (gnu packages php)
+ #:use-module (gnu packages guile)
#:use-module (guix records)
+ #:use-module (guix modules)
#:use-module (guix gexp)
#:use-module ((guix utils) #:select (version-major))
#:use-module ((guix packages) #:select (package-version))
@@ -155,7 +159,11 @@
php-fpm-service-type
nginx-php-location
- cat-avatar-generator-service))
+ cat-avatar-generator-service
+
+ hpcguix-web-configuration
+ hpcguix-web-configuration?
+ hpcguix-web-service-type))
;;; Commentary:
;;;
@@ -893,3 +901,65 @@ a webserver.")
(nginx-server-configuration-locations configuration)))
(root #~(string-append #$package
"/share/web/cat-avatar-generator"))))))
+
+
+(define-record-type* <hpcguix-web-configuration>
+ hpcguix-web-configuration make-hpcguix-web-configuration
+ hpcguix-web-configuration?
+
+ (package hpcguix-web-package (default hpcguix-web)) ;<package>
+
+ ;; Specs is gexp of hpcguix-web configuration file
+ (specs hpcguix-web-configuration-specs))
+
+(define %hpcguix-web-accounts
+ (list (user-group
+ (name "hpcguix-web")
+ (system? #t))
+ (user-account
+ (name "hpcguix-web")
+ (group "hpcguix-web")
+ (system? #t)
+ (comment "hpcguix-web")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define %hpcguix-web-activation
+ #~(begin
+ (use-modules (guix build utils))
+ (let ((home-dir "/var/cache/guix/web")
+ (user (getpwnam "hpcguix-web")))
+ (mkdir-p home-dir)
+ (chown home-dir (passwd:uid user) (passwd:gid user))
+ (chmod home-dir #o755))))
+
+(define (hpcguix-web-shepherd-service config)
+ (let ((specs (hpcguix-web-configuration-specs config))
+ (hpcguix-web (hpcguix-web-package config)))
+ (with-imported-modules (source-module-closure
+ '((gnu build shepherd)))
+ (shepherd-service
+ (documentation "hpcguix-web daemon")
+ (provision '(hpcguix-web))
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ (list #$(file-append hpcguix-web "/bin/run")
+ (string-append "--config="
+ #$(scheme-file "hpcguix-web.scm" specs)))
+ #:user "hpcguix-web"
+ #:group "hpcguix-web"
+ #:environment-variables
+ (list "XDG_CACHE_HOME=/var/cache")))
+ (stop #~(make-kill-destructor))))))
+
+(define hpcguix-web-service-type
+ (service-type
+ (name 'hpcguix-web)
+ (description "Run the hpcguix-web server.")
+ (extensions
+ (list (service-extension account-service-type
+ (const %hpcguix-web-accounts))
+ (service-extension activation-service-type
+ (const %hpcguix-web-activation))
+ (service-extension shepherd-root-service-type
+ (compose list hpcguix-web-shepherd-service))))))
diff --git a/gnu/system.scm b/gnu/system.scm
index c53bccf82c..f3dafd144b 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -317,8 +317,8 @@ file system labels."
(_ ;the old format
"/")))))
(x ;unsupported format
- (warning (G_ "unrecognized boot parameters for '~a'~%")
- system)
+ (warning (G_ "unrecognized boot parameters at '~a'~%")
+ (port-filename port))
#f)))
(define (read-boot-parameters-file system)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index cf730d1f08..8cfbda2264 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -410,58 +410,57 @@ should set REGISTER-CLOSURES? to #f."
(eval-when (expand load eval)
(define %libgcrypt
#+(file-append libgcrypt "/lib/libgcrypt"))))))
+
(mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t))
(name -> (string-append name ".tar.gz"))
(graph -> "system-graph"))
(define build
- (with-imported-modules `(,@(source-module-closure '((guix docker)
- (guix build utils)
- (gnu build vm))
- #:select? not-config?)
- (guix build store-copy)
- ((guix config) => ,config))
- #~(begin
- ;; Guile-JSON is required by (guix docker).
- (add-to-load-path
- (string-append #+guile-json "/share/guile/site/"
- (effective-version)))
- (use-modules (guix docker)
- (guix build utils)
- (gnu build vm)
- (srfi srfi-19)
- (guix build store-copy))
-
- (let* ((inputs '#$(append (list tar)
- (if register-closures?
- (list guix)
- '())))
- ;; This initializer requires elevated privileges that are
- ;; not normally available in the build environment (e.g.,
- ;; it needs to create device nodes). In order to obtain
- ;; such privileges, we run it as root in a VM.
- (initialize (root-partition-initializer
- #:closures '(#$graph)
- #:register-closures? #$register-closures?
- #:system-directory #$os-drv
- ;; De-duplication would fail due to
- ;; cross-device link errors, so don't do it.
- #:deduplicate? #f))
- ;; Even as root in a VM, the initializer would fail due to
- ;; lack of privileges if we use a root-directory that is on
- ;; a file system that is shared with the host (e.g., /tmp).
- (root-directory "/guixsd-system-root"))
- (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
- (mkdir root-directory)
- (initialize root-directory)
- (build-docker-image
- (string-append "/xchg/" #$name) ;; The output file.
- (cons* root-directory
- (call-with-input-file (string-append "/xchg/" #$graph)
- read-reference-graph))
- #$os-drv
- #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
- #:creation-time (make-time time-utc 0 1)
- #:transformations `((,root-directory -> "")))))))
+ (with-extensions (list guile-json) ;for (guix docker)
+ (with-imported-modules `(,@(source-module-closure
+ '((guix docker)
+ (guix build utils)
+ (gnu build vm))
+ #:select? not-config?)
+ (guix build store-copy)
+ ((guix config) => ,config))
+ #~(begin
+ (use-modules (guix docker)
+ (guix build utils)
+ (gnu build vm)
+ (srfi srfi-19)
+ (guix build store-copy))
+
+ (let* ((inputs '#$(append (list tar)
+ (if register-closures?
+ (list guix)
+ '())))
+ ;; This initializer requires elevated privileges that are
+ ;; not normally available in the build environment (e.g.,
+ ;; it needs to create device nodes). In order to obtain
+ ;; such privileges, we run it as root in a VM.
+ (initialize (root-partition-initializer
+ #:closures '(#$graph)
+ #:register-closures? #$register-closures?
+ #:system-directory #$os-drv
+ ;; De-duplication would fail due to
+ ;; cross-device link errors, so don't do it.
+ #:deduplicate? #f))
+ ;; Even as root in a VM, the initializer would fail due to
+ ;; lack of privileges if we use a root-directory that is on
+ ;; a file system that is shared with the host (e.g., /tmp).
+ (root-directory "/guixsd-system-root"))
+ (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+ (mkdir root-directory)
+ (initialize root-directory)
+ (build-docker-image
+ (string-append "/xchg/" #$name) ;; The output file.
+ (cons* root-directory
+ (call-with-input-file (string-append "/xchg/" #$graph)
+ read-reference-graph))
+ #$os-drv
+ #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
+ #:creation-time (make-time time-utc 0 1)
+ #:transformations `((,root-directory -> ""))))))))
(expression->derivation-in-linux-vm
name
;; The VM's initrd Guile doesn't support dlopen, but our "build" gexp
diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm
index b9c741e3e0..4431e37dc1 100644
--- a/gnu/tests/dict.scm
+++ b/gnu/tests/dict.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -96,22 +96,7 @@
;; Wait until dicod is actually listening.
;; TODO: Use a PID file instead.
(test-assert "connect inside"
- (marionette-eval
- '(begin
- (use-modules (ice-9 rdelim))
- (let ((sock (socket PF_INET SOCK_STREAM 0)))
- (let loop ((i 0))
- (pk 'try i)
- (catch 'system-error
- (lambda ()
- (connect sock AF_INET INADDR_LOOPBACK 2628))
- (lambda args
- (pk 'connection-error args)
- (when (< i 20)
- (sleep 1)
- (loop (+ 1 i))))))
- (read-line sock 'concat)))
- marionette))
+ (wait-for-tcp-port 2628 marionette))
(test-assert "connect"
(let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 6abc6c2501..9247a43e6d 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
@@ -49,156 +49,150 @@ When SFTP? is true, run an SFTP server test."
(define test
(with-imported-modules '((gnu build marionette))
- #~(begin
- (eval-when (expand load eval)
- ;; Prepare to use Guile-SSH.
- (set! %load-path
- (cons (string-append #+guile-ssh "/share/guile/site/"
- (effective-version))
- %load-path)))
-
- (use-modules (gnu build marionette)
- (srfi srfi-26)
- (srfi srfi-64)
- (ice-9 match)
- (ssh session)
- (ssh auth)
- (ssh channel)
- (ssh sftp))
-
- (define marionette
- ;; Enable TCP forwarding of the guest's port 22.
- (make-marionette (list #$vm)))
-
- (define (make-session-for-test)
- "Make a session with predefined parameters for a test."
- (make-session #:user "root"
- #:port 2222
- #:host "localhost"
- #:log-verbosity 'protocol))
-
- (define (call-with-connected-session proc)
- "Call the one-argument procedure PROC with a freshly created and
+ (with-extensions (list guile-ssh)
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-26)
+ (srfi srfi-64)
+ (ice-9 match)
+ (ssh session)
+ (ssh auth)
+ (ssh channel)
+ (ssh sftp))
+
+ (define marionette
+ ;; Enable TCP forwarding of the guest's port 22.
+ (make-marionette (list #$vm)))
+
+ (define (make-session-for-test)
+ "Make a session with predefined parameters for a test."
+ (make-session #:user "root"
+ #:port 2222
+ #:host "localhost"
+ #:log-verbosity 'protocol))
+
+ (define (call-with-connected-session proc)
+ "Call the one-argument procedure PROC with a freshly created and
connected SSH session object, return the result of the procedure call. The
session is disconnected when the PROC is finished."
- (let ((session (make-session-for-test)))
- (dynamic-wind
- (lambda ()
- (let ((result (connect! session)))
- (unless (equal? result 'ok)
- (error "Could not connect to a server"
- session result))))
- (lambda () (proc session))
- (lambda () (disconnect! session)))))
-
- (define (call-with-connected-session/auth proc)
- "Make an authenticated session. We should be able to connect as
+ (let ((session (make-session-for-test)))
+ (dynamic-wind
+ (lambda ()
+ (let ((result (connect! session)))
+ (unless (equal? result 'ok)
+ (error "Could not connect to a server"
+ session result))))
+ (lambda () (proc session))
+ (lambda () (disconnect! session)))))
+
+ (define (call-with-connected-session/auth proc)
+ "Make an authenticated session. We should be able to connect as
root with an empty password."
- (call-with-connected-session
- (lambda (session)
- ;; Try the simple authentication methods. Dropbear requires
- ;; 'none' when there are no passwords, whereas OpenSSH accepts
- ;; 'password' with an empty password.
- (let loop ((methods (list (cut userauth-password! <> "")
- (cut userauth-none! <>))))
- (match methods
- (()
- (error "all the authentication methods failed"))
- ((auth rest ...)
- (match (pk 'auth (auth session))
- ('success
- (proc session))
- ('denied
- (loop rest)))))))))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "ssh-daemon")
-
- ;; Wait for sshd to be up and running.
- (test-eq "service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'ssh-daemon)
- 'running!)
- marionette))
-
- ;; Check sshd's PID file.
- (test-equal "sshd PID"
- (wait-for-file #$pid-file marionette)
- (marionette-eval
- '(begin
- (use-modules (gnu services herd)
- (srfi srfi-1))
-
- (live-service-running
- (find (lambda (live)
- (memq 'ssh-daemon
- (live-service-provision live)))
- (current-services))))
- marionette))
-
- ;; Connect to the guest over SSH. Make sure we can run a shell
- ;; command there.
- (test-equal "shell command"
- 'hello
- (call-with-connected-session/auth
- (lambda (session)
- ;; FIXME: 'get-server-public-key' segfaults.
- ;; (get-server-public-key session)
- (let ((channel (make-channel session)))
- (channel-open-session channel)
- (channel-request-exec channel "echo hello > /root/witness")
- (and (zero? (channel-get-exit-status channel))
- (wait-for-file "/root/witness" marionette))))))
-
- ;; Connect to the guest over SFTP. Make sure we can write and
- ;; read a file there.
- (unless #$sftp?
- (test-skip 1))
- (test-equal "SFTP file writing and reading"
- 'hello
- (call-with-connected-session/auth
- (lambda (session)
- (let ((sftp-session (make-sftp-session session))
- (witness "/root/sftp-witness"))
- (call-with-remote-output-file sftp-session witness
- (cut display "hello" <>))
- (call-with-remote-input-file sftp-session witness
- read)))))
-
- ;; Connect to the guest over SSH. Make sure we can run commands
- ;; from the system profile.
- (test-equal "run executables from system profile"
- #t
- (call-with-connected-session/auth
- (lambda (session)
- (let ((channel (make-channel session)))
- (channel-open-session channel)
- (channel-request-exec
- channel
- (string-append
- "mkdir -p /root/.guix-profile/bin && "
- "touch /root/.guix-profile/bin/path-witness && "
- "chmod 755 /root/.guix-profile/bin/path-witness"))
- (zero? (channel-get-exit-status channel))))))
-
- ;; Connect to the guest over SSH. Make sure we can run commands
- ;; from the user profile.
- (test-equal "run executable from user profile"
- #t
- (call-with-connected-session/auth
- (lambda (session)
- (let ((channel (make-channel session)))
- (channel-open-session channel)
- (channel-request-exec channel "path-witness")
- (zero? (channel-get-exit-status channel))))))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+ (call-with-connected-session
+ (lambda (session)
+ ;; Try the simple authentication methods. Dropbear requires
+ ;; 'none' when there are no passwords, whereas OpenSSH accepts
+ ;; 'password' with an empty password.
+ (let loop ((methods (list (cut userauth-password! <> "")
+ (cut userauth-none! <>))))
+ (match methods
+ (()
+ (error "all the authentication methods failed"))
+ ((auth rest ...)
+ (match (pk 'auth (auth session))
+ ('success
+ (proc session))
+ ('denied
+ (loop rest)))))))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "ssh-daemon")
+
+ ;; Wait for sshd to be up and running.
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'ssh-daemon)
+ 'running!)
+ marionette))
+
+ ;; Check sshd's PID file.
+ (test-equal "sshd PID"
+ (wait-for-file #$pid-file marionette)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd)
+ (srfi srfi-1))
+
+ (live-service-running
+ (find (lambda (live)
+ (memq 'ssh-daemon
+ (live-service-provision live)))
+ (current-services))))
+ marionette))
+
+ ;; Connect to the guest over SSH. Make sure we can run a shell
+ ;; command there.
+ (test-equal "shell command"
+ 'hello
+ (call-with-connected-session/auth
+ (lambda (session)
+ ;; FIXME: 'get-server-public-key' segfaults.
+ ;; (get-server-public-key session)
+ (let ((channel (make-channel session)))
+ (channel-open-session channel)
+ (channel-request-exec channel "echo hello > /root/witness")
+ (and (zero? (channel-get-exit-status channel))
+ (wait-for-file "/root/witness" marionette))))))
+
+ ;; Connect to the guest over SFTP. Make sure we can write and
+ ;; read a file there.
+ (unless #$sftp?
+ (test-skip 1))
+ (test-equal "SFTP file writing and reading"
+ 'hello
+ (call-with-connected-session/auth
+ (lambda (session)
+ (let ((sftp-session (make-sftp-session session))
+ (witness "/root/sftp-witness"))
+ (call-with-remote-output-file sftp-session witness
+ (cut display "hello" <>))
+ (call-with-remote-input-file sftp-session witness
+ read)))))
+
+ ;; Connect to the guest over SSH. Make sure we can run commands
+ ;; from the system profile.
+ (test-equal "run executables from system profile"
+ #t
+ (call-with-connected-session/auth
+ (lambda (session)
+ (let ((channel (make-channel session)))
+ (channel-open-session channel)
+ (channel-request-exec
+ channel
+ (string-append
+ "mkdir -p /root/.guix-profile/bin && "
+ "touch /root/.guix-profile/bin/path-witness && "
+ "chmod 755 /root/.guix-profile/bin/path-witness"))
+ (zero? (channel-get-exit-status channel))))))
+
+ ;; Connect to the guest over SSH. Make sure we can run commands
+ ;; from the user profile.
+ (test-equal "run executable from user profile"
+ #t
+ (call-with-connected-session/auth
+ (lambda (session)
+ (let ((channel (make-channel session)))
+ (channel-open-session channel)
+ (channel-request-exec channel "path-witness")
+ (zero? (channel-get-exit-status channel))))))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0))))))
(gexp->derivation name test))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 1912f8f79d..a6bf6efcfe 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,7 +32,8 @@
#:use-module (guix store)
#:export (%test-httpd
%test-nginx
- %test-php-fpm))
+ %test-php-fpm
+ %test-hpcguix-web))
(define %index.html-contents
;; Contents of the /index.html file.
@@ -281,3 +283,81 @@ HTTP-PORT, along with php-fpm."
(name "php-fpm")
(description "Test PHP-FPM through nginx.")
(value (run-php-fpm-test))))
+
+
+;;;
+;;; hpcguix-web
+;;;
+
+(define* (run-hpcguix-web-server-test name test-os)
+ "Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running."
+ (define os
+ (marionette-operating-system
+ test-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '((8080 . 5000)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-11) (srfi srfi-64)
+ (gnu build marionette)
+ (web uri)
+ (web client)
+ (web response))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin #$name)
+
+ (test-assert "hpcguix-web running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (match (start-service 'hpcguix-web)
+ (#f #f)
+ (('service response-parts ...)
+ (match (assq-ref response-parts 'running)
+ ((pid) (number? pid))))))
+ marionette))
+
+ (test-equal "http-get"
+ 200
+ (begin
+ (wait-for-tcp-port 5000 marionette)
+ (let-values (((response text)
+ (http-get "http://localhost:8080")))
+ (response-code response))))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation (string-append name "-test") test))
+
+(define %hpcguix-web-specs
+ ;; Server config gexp.
+ #~(define site-config
+ (hpcweb-configuration
+ (title-prefix "[TEST] HPCGUIX-WEB"))))
+
+(define %hpcguix-web-os
+ (simple-operating-system
+ (dhcp-client-service)
+ (service hpcguix-web-service-type
+ (hpcguix-web-configuration
+ (specs %hpcguix-web-specs)))))
+
+(define %test-hpcguix-web
+ (system-test
+ (name "hpcguix-web")
+ (description "Connect to a running hpcguix-web server.")
+ (value (run-hpcguix-web-server-test name %hpcguix-web-os))))
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-18 15:35:08 +0000