branch master updated: hydra: services: Add service for the Guix Packages website.

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository maintenance.

The following commit(s) were added to refs/heads/master by this push:
     new d36fd16  hydra: services: Add service for the Guix Packages website.
d36fd16 is described below

commit d36fd168a95587f762534d40663f27e94fe22359
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Jan 15 16:23:18 2023 +0000

    hydra: services: Add service for the Guix Packages website.
    
    This has been running on bayfront in a screen session, but this commit
    adds configuration so it's run by the shepherd.
    
    * hydra/modules/sysadmin/services.scm (guix-packages-website-configuration,
    guix-packages-website-configuration?,
    guix-packages-website-configuration-origin,
    guix-packages-website-configuration-port,
    guix-packages-website-configuration-host): New procedures.
    (guix-packages-website-service-type): New variable.
    * hydra/bayfront.scm <services>: Add service for the Guix packages website.
---
 hydra/bayfront.scm                  |   2 +
 hydra/modules/sysadmin/services.scm | 168 +++++++++++++++++++++++++++++++++++-
 2 files changed, 169 insertions(+), 1 deletion(-)

diff --git a/hydra/bayfront.scm b/hydra/bayfront.scm
index a4c7a21..74c9c80 100644
--- a/hydra/bayfront.scm
+++ b/hydra/bayfront.scm
@@ -1109,6 +1109,8 @@ add_header Content-Type text/plain;")))
               (submit-builds? #t)
               (manage-patch-branches? #t)))
 
+    (service guix-packages-website-service-type)
+
     (service mcron-service-type
              (mcron-configuration
               (jobs
diff --git a/hydra/modules/sysadmin/services.scm 
b/hydra/modules/sysadmin/services.scm
index e44a464..bdc7a3f 100644
--- a/hydra/modules/sysadmin/services.scm
+++ b/hydra/modules/sysadmin/services.scm
@@ -75,7 +75,15 @@
             qa-frontpage-configuration-submit-builds?
             qa-frontpage-configuration-manage-patch-branches?
 
-            qa-frontpage-service-type))
+            qa-frontpage-service-type
+
+            guix-packages-website-configuration
+            guix-packages-website-configuration?
+            guix-packages-website-configuration-origin
+            guix-packages-website-configuration-port
+            guix-packages-website-configuration-host
+
+            guix-packages-website-service-type))
 
 (define not-config?
   ;; Select (guix …) and (gnu …) modules, except (guix config).
@@ -1129,3 +1137,161 @@ to a selected directory.")
                                         qa-frontpage-shepherd-services)))
    (default-value (qa-frontpage-configuration))
    (description "Run the QA frontpage.")))
+
+
+;;;
+;;; packages.guix.gnu.org
+;;;
+
+(define-record-type* <guix-packages-website-configuration>
+  guix-packages-website-configuration make-guix-packages-website-configuration
+  guix-packages-website-configuration?
+  (origin         guix-packages-website-configuration-origin
+                  (default
+                    (let* ((commit "72817057c0ba86663ae0a29bde13c15b686600d0")
+                          (version (git-version "0" "0" commit)))
+                      (origin
+                        (method git-fetch)
+                        (uri (git-reference
+                              (url 
"https://codeberg.org/luis-felipe/guix-packages-website.git";)
+                              (commit commit)))
+                        (file-name (git-file-name "guix-packages-website" 
version))
+                        (sha256
+                         (base32
+                          
"0jm0aipdw97sb1lwzczgwzacv9jgyippgq79na87647lqapq8fcx"))
+                        (modules '((guix build utils)))
+                        (snippet
+                         '(begin
+                            (use-modules (guix build utils))
+
+                            ;; TODO This seemed to be needed to avoid
+                            ;; `path` being undefined when Guile tries
+                            ;; to load urls.scm
+                            (substitute* "gweb/urls.scm"
+                              (("define MANUAL_URL .*$")
+                               "define MANUAL_URL 
\"https://www.gnu.org/software/guix/manual\";)\n"))))))))
+  (port           guix-packages-website-configuration-port
+                  (default 3000))
+  (host           guix-packages-website-configuration-host
+                  (default "127.0.0.1")))
+
+(define (guix-packages-website-shepherd-services config)
+  (match-record config <guix-packages-website-configuration>
+    (origin port host)
+
+    (define program/wrapped
+      (least-authority-wrapper
+       (program-file
+        "wrapped-art"
+        (with-extensions (list artanis guile-json-4)
+          #~(begin
+              (use-modules (srfi srfi-1))
+              (let ((script
+                     #$(file-append artanis "/bin/art")))
+                (for-each
+                 (lambda (var lst)
+                   (setenv var
+                           (string-join
+                            (append (take lst 2)
+                                    (or (and=> (getenv var)
+                                               list)
+                                        '()))
+                            ":")))
+                 '("GUILE_LOAD_PATH"
+                   "GUILE_LOAD_COMPILED_PATH")
+                 (list %load-path
+                       %load-compiled-path))
+                (setenv "GUILE_LOAD_PATH"
+                        (string-append
+                         #$origin ":" (getenv "GUILE_LOAD_PATH")))
+                (apply execl
+                       script
+                       script
+                       (cdr (command-line)))))))
+       #:name "wrapped-art-for-guix-packages-website"
+
+       ;; TODO I think this approach might be OK, but it's pretty
+       ;; terrible at the moment. Artanis seems to require deleting
+       ;; and re-creating the .route file at the top level of the
+       ;; project directory upon startup, which means that you can't
+       ;; just bind mount the source code as read only, then bind
+       ;; mount specific directories as read write.
+       ;;
+       ;; To get around that, specific files and directories in the
+       ;; source are bind mounted in to
+       ;; /var/lib/guix-packages-website, but that's quite fragile.
+       #:mappings (cons* (file-system-mapping
+                          (source "/var/lib/guix-packages-website")
+                          (target source)
+                          (writable? #t))
+                         (file-system-mapping
+                          (source "/var/cache/guix-packages-website")
+                          (target "/var/lib/guix-packages-website/tmp/cache")
+                          (writable? #t))
+                         (file-system-mapping
+                          (source (file-append glibc-utf8-locales 
"/lib/locale"))
+                          (target "/run/current-system/locale"))
+                         (map (lambda (file)
+                                (file-system-mapping
+                                 (source (file-append origin (string-append 
"/" file)))
+                                 (target (string-append 
"/var/lib/guix-packages-website/" file))))
+                              '("conf" "ENTRY" "gweb" "icon.svg" "pub")))
+       #:directory "/var/lib/guix-packages-website"
+       #:namespaces (delq 'net %namespaces)
+       #:preserved-environment-variables '("GUIX_LOCPATH" "LC_ALL" "HOME")))
+
+    (list (shepherd-service
+           (provision '(guix-packages-website))
+           (requirement '(user-processes networking))
+           (start #~(make-forkexec-constructor
+                     (list #$program/wrapped
+                           "work"
+                           #$@(if port
+                                  #~(#$(simple-format #f "--port=~A" port))
+                                  '())
+                           #$@(if host
+                                  #~(#$(string-append "--host=" host))
+                                  '()))
+                     #:user "guix-packages-website" #:group 
"guix-packages-website"
+                     #:log-file "/var/log/guix-packages-website.log"
+                     #:directory "/var/lib/guix-packages-website"
+                     #:environment-variables
+                     (list "GUIX_LOCPATH=/run/current-system/locale"
+                           "LC_ALL=en_US.utf8"
+                           "HOME=/var/lib/guix-packages-website")))
+           (stop #~(make-kill-destructor))
+           (documentation "Run the Guix Packages website.")))))
+
+(define (guix-packages-website-activation config)
+  (let ((cache-directory "/var/cache/guix-packages-website"))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+          (mkdir-p #$cache-directory)
+          (let ((pw (getpw "guix-packages-website")))
+            (chown #$cache-directory
+                   (passwd:uid pw) (passwd:gid pw)))))))
+
+(define %guix-packages-website-accounts
+  (list (user-account
+         (name "guix-packages-website")
+         (group "guix-packages-website")
+         (home-directory "/var/lib/guix-packages-website")
+         (shell (file-append shadow "/sbin/nologin"))
+         (comment "The Guix Packages website.")
+         (system? #t))
+        (user-group
+         (name "guix-packages-website")
+         (system? #t))))
+
+(define guix-packages-website-service-type
+  (service-type
+   (name 'guix-packages-website)
+   (extensions (list (service-extension account-service-type
+                                        (const 
%guix-packages-website-accounts))
+                     (service-extension activation-service-type
+                                        guix-packages-website-activation)
+                     (service-extension shepherd-root-service-type
+                                        
guix-packages-website-shepherd-services)))
+   (default-value (guix-packages-website-configuration))
+   (description "Run the Guix Packages website.")))