04/14: services: Add hpcguix-web.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 93b83eb31e35aedaafcc40cfbb9a8743e0f6352d
Author: Rouby Pierre-Antoine <address@hidden>
Date:   Wed May 30 11:47:04 2018 +0200

    services: Add hpcguix-web.
    
    * gnu/service/web.scm (<hpcguix-web-configuration>): New record-type.
      (%hpcguix-web-accounts): New variable.
      (%hpcguix-web-activation,hpcguix-web-shepherd-service,
      hpcguix-web-service-type): New procedures.
    * gnu/tests/web.scm (run-hpcguix-web-server-test): New procedure.
      (%hpcguix-web-specs, %hpcguix-web-os, %test-hpcguix-web): New variable.
    * doc/guix.texi (Web Services): Add 'hpcguix-web'.
    
    Co-authored-by: Ludovic Courtès <address@hidden>
---
 doc/guix.texi        | 61 +++++++++++++++++++++++++++++++++++++-
 gnu/services/web.scm | 72 ++++++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/web.scm    | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 212 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 09749b1..3b50787 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -47,7 +47,8 @@ Copyright @copyright{} 2017, 2018 Arun address@hidden
 Copyright @copyright{} 2017 address@hidden
 Copyright @copyright{} 2018 Rutger address@hidden
 Copyright @copyright{} 2018 Oleg address@hidden
-Copyright @copyright{} 2018 Mike Gerwitz
+Copyright @copyright{} 2018 Mike address@hidden
+Copyright @copyright{} 2018 Pierre-Antoine Rouby
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -16159,6 +16160,64 @@ A simple setup for cat-avatar-generator can look like 
this:
                  %base-services))
 @end example
 
address@hidden Hpcguix-web
+
address@hidden hpcguix-web
+The @uref{hpcguix-web, https://github.com/UMCUGenetics/hpcguix-web/}
+program is a customizable web interface to browse Guix packages,
+initially designed for users of high-performance computing (HPC)
+clusters.
+
address@hidden {Scheme Variable} hpcguix-web-service-type
+The service type for @code{hpcguix-web}.
address@hidden defvr
+
address@hidden {Data Type} hpcguix-web-configuration
+Data type for the hpcguix-web service configuration.
+
address@hidden @asis
address@hidden @code{specs}
+A gexp (@pxref{G-Expressions}) specifying the hpcguix-web service
+configuration.  The main items available in this spec are:
+
address@hidden @asis
address@hidden @code{title-prefix} (default: @code{"hpcguix | "})
+The page title prefix.
+
address@hidden @code{guix-command} (default: @code{"guix"})
+The @command{guix} command.
+
address@hidden @code{package-filter-proc} (default: @code{(const #t)})
+A procedure specifying how to filter packages that are displayed.
+
address@hidden @code{package-page-extension-proc} (default: @code{(const '())})
+Extension package for @code{hpcguix-web}.
+
address@hidden @code{menu} (default: @code{'()})
+Additional entry in page @code{menu}.
address@hidden table
+
+See the hpcguix-web repository for a
address@hidden://github.com/UMCUGenetics/hpcguix-web/blob/master/hpcweb-configuration.scm,
+complete example}.
+
address@hidden @code{package} (default: @code{hpcguix-web})
+The hpcguix-web package to use.
address@hidden table
address@hidden deftp
+
+A typical hpcguix-web service declaration looks like this:
+
address@hidden
+(service hpcguix-web-service-type
+         (hpcguix-web-configuration
+          (specs
+           #~(define site-config
+               (hpcweb-configuration
+                (title-prefix "Guix-HPC - ")
+                (menu '(("/about" "ABOUT"))))))))
address@hidden example
+
 @node Certificate Services
 @subsubsection Certificate Services
 
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index b336a8d..aae2f3d 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2017 Christopher Baines <address@hidden>
 ;;; Copyright © 2017 nee <address@hidden>
 ;;; Copyright © 2017 Clément Lassieur <address@hidden>
+;;; Copyright © 2018 Pierre-Antoine Rouby <address@hidden>
 ;;;
 ;;; 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/tests/web.scm b/gnu/tests/web.scm
index 1912f8f..a6bf6ef 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2017 Christopher Baines <address@hidden>
 ;;; Copyright © 2017 Clément Lassieur <address@hidden>
+;;; Copyright © 2018 Pierre-Antoine Rouby <address@hidden>
 ;;;
 ;;; 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))))