GNU bug report logs - #61122
[PATCH] services: Add mympd-service-type.

Previous Next

Package: guix-patches;

Reported by: Bruno Victal <mirai <at> makinata.eu>

Date: Sat, 28 Jan 2023 13:55:01 UTC

Severity: normal

Tags: patch

Done: Liliana Marie Prikler <liliana.prikler <at> gmail.com>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 61122 in the body.
You can then email your comments to 61122 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#61122; Package guix-patches. (Sat, 28 Jan 2023 13:55:01 GMT) Full text and rfc822 format available.

Acknowledgement sent to Bruno Victal <mirai <at> makinata.eu>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Sat, 28 Jan 2023 13:55:01 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Bruno Victal <mirai <at> makinata.eu>
To: guix-patches <at> gnu.org
Cc: Bruno Victal <mirai <at> makinata.eu>
Subject: [PATCH] services: Add mympd-service-type.
Date: Sat, 28 Jan 2023 13:53:43 +0000
* gnu/services/audio.scm (mympd-service-type): New variable.
* gnu/tests/audio.scm (%test-mympd): New variable.
* doc/guix.texi: Document it.
---
 doc/guix.texi          | 115 +++++++++++++++++
 gnu/services/audio.scm | 273 ++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/audio.scm    |  54 +++++++-
 3 files changed, 440 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2b1ad77ba5..790696783c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -112,6 +112,7 @@
 Copyright @copyright{} 2022 Ivan Vilata-i-Balaguer@*
 Copyright @copyright{} 2023 Giacomo Leidi@*
 Copyright @copyright{} 2022 Antero Mejr@*
+Copyright @copyright{} 2022 Bruno Victal@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -33272,6 +33273,120 @@ Audio Services
                         (port    . "8080"))))))))
 @end lisp
 
+@subsubheading myMPD
+
+@cindex MPD, web interface
+@cindex myMPD service
+
+@uref{https://jcorporation.github.io/myMPD/, myMPD} is a web server
+frontend for MPD that provides a mobile friendly web client for MPD.
+
+The following example shows a myMPD instance listening on port 80,
+with album cover caching disabled.
+
+@lisp
+(service mympd-service-type
+         (mympd-configuration
+          (port 80)
+          (covercache-ttl 0)))
+@end lisp
+
+@defvar mympd-service-type
+The service type for @command{mympd}.
+@end defvar
+
+@c %start of fragment
+@deftp {Data Type} mympd-configuration
+Available @code{mympd-configuration} fields are:
+
+@table @asis
+@item @code{package} (default: @code{mympd}) (type: file-like)
+The package object of the myMPD server.
+
+@item @code{shepherd-requirement} (default: @code{()}) (type: list-of-symbol)
+This is a list of symbols naming Shepherd services that this service
+will depend on.
+
+@item @code{user} (default: @code{"mympd"}) (type: string)
+Owner of the @command{mympd} process.
+
+@item @code{group} (default: @code{"nogroup"}) (type: string)
+Owner group of the @command{mympd} process.
+
+@item @code{work-directory} (default: @code{"/var/lib/mympd"}) (type: string)
+Where myMPD will store its data.
+
+@item @code{cache-directory} (default: @code{"/var/cache/mympd"}) (type: string)
+Where myMPD will store its cache.
+
+@item @code{acl} (type: maybe-ip-acl)
+ACL to access the myMPD webserver.  See
+@uref{https://jcorporation.github.io/myMPD/configuration/acl,myMPD ACL}
+for syntax.
+
+@item @code{covercache-ttl} (default: @code{31}) (type: maybe-integer)
+How long to keep cached covers, @code{0} disables cover caching.
+
+@item @code{http?} (default: @code{#t}) (type: boolean)
+HTTP support.
+
+@item @code{host} (default: @code{"[::]"}) (type: string)
+Host name to listen on.
+
+@item @code{port} (default: @code{80}) (type: maybe-port)
+HTTP port to listen on.
+
+@item @code{log-level} (default: @code{5}) (type: integer)
+How much detail to include in logs, possible values: @code{0} to
+@code{7}.
+
+@item @code{log-to} (default: @code{"/var/log/mympd/log"}) (type: string-or-symbol)
+Where to send logs.  By default, the service logs to
+@file{/var/log/mympd.log}.  The alternative is @code{'syslog}, which
+sends output to the running syslog service under the @samp{daemon}
+facility.
+
+@item @code{lualibs} (default: @code{"all"}) (type: maybe-string)
+See
+@uref{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.
+
+@item @code{script-acl} (default: @code{(ip-acl (allow '("127.0.0.1")))}) (type: maybe-ip-acl)
+ACL to access the myMPD script backend.
+
+@item @code{ssl?} (default: @code{#f}) (type: boolean)
+SSL/TLS support.
+
+@item @code{ssl-port} (default: @code{443}) (type: maybe-port)
+Port to listen for HTTPS.
+
+@item @code{ssl-cert} (type: maybe-string)
+Path to PEM encoded X.509 SSL/TLS certificate (public key).
+
+@item @code{ssl-key} (type: maybe-string)
+Path to PEM encoded SSL/TLS private key.
+
+@item @code{pin-hash} (type: maybe-string)
+SHA-256 hashed pin used by myMPD to control settings access by prompting
+a pin from the user.
+
+@end table
+@end deftp
+@c %end of fragment
+
+@c %start of fragment
+@deftp {Data Type} ip-acl
+Available @code{ip-acl} fields are:
+
+@table @asis
+@item @code{allow} (default: @code{()}) (type: list-of-string)
+Allowed IP addresses.
+
+@item @code{deny} (default: @code{()}) (type: list-of-string)
+Disallowed IP addresses.
+
+@end table
+@end deftp
+@c %end of fragment
 
 @node Virtualization Services
 @subsection Virtualization Services
diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index c60053f33c..c384d3d2b8 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2020 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2022 Bruno Victal <mirai <at> makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,8 @@
 (define-module (gnu services audio)
   #:use-module (guix gexp)
   #:use-module (gnu services)
+  #:use-module (gnu services admin)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages admin)
@@ -28,11 +31,41 @@ (define-module (gnu services audio)
   #:use-module (guix records)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (mpd-output
             mpd-output?
             mpd-configuration
             mpd-configuration?
-            mpd-service-type))
+            mpd-service-type
+
+            mympd-service-type
+            mympd-configuration
+            mympd-configuration?
+            mympd-configuration-package
+            mympd-configuration-shepherd-requirement
+            mympd-configuration-user
+            mympd-configuration-group
+            mympd-configuration-work-directory
+            mympd-configuration-cache-directory
+            mympd-configuration-acl
+            mympd-configuration-covercache-ttl
+            mympd-configuration-http?
+            mympd-configuration-host
+            mympd-configuration-port
+            mympd-configuration-log-level
+            mympd-configuration-log-to
+            mympd-configuration-lualibs
+            mympd-configuration-script-acl
+            mympd-configuration-ssl?
+            mympd-configuration-ssl-port
+            mympd-configuration-ssl-cert
+            mympd-configuration-ssl-key
+            mympd-configuration-pin-hash
+            ip-acl
+            ip-acl?
+            ip-acl-allow
+            ip-acl-deny))
 
 ;;; Commentary:
 ;;;
@@ -197,3 +230,241 @@ (define mpd-service-type
           (service-extension activation-service-type
                              mpd-service-activation)))
    (default-value (mpd-configuration))))
+
+
+;;;
+;;; myMPD
+;;;
+
+(define list-of-symbol?
+  (list-of symbol?))
+
+(define list-of-string?
+  (list-of string?))
+
+(define (port? n)
+  (and (integer? n)
+       (<= 0 n 65535)))
+
+(define (string-or-symbol? x)
+  (or (symbol? x) (string? x)))
+
+(define-configuration/no-serialization ip-acl
+  (allow
+   (list-of-string '())
+   "Allowed IP addresses.")
+
+  (deny
+   (list-of-string '())
+   "Disallowed IP addresses."))
+
+(define-maybe/no-serialization port)
+(define-maybe/no-serialization integer)
+(define-maybe/no-serialization string)
+(define-maybe/no-serialization ip-acl)
+
+;; XXX: The serialization procedures are insufficient since we require
+;; access to multiple fields at once.
+;; Fields marked with empty-serializer are never serialized and are
+;; used for command-line arguments or by the service definition.
+(define-configuration/no-serialization mympd-configuration
+  (package
+    (file-like mympd)
+    "The package object of the myMPD server."
+    empty-serializer)
+
+  (shepherd-requirement
+   (list-of-symbol '())
+   "This is a list of symbols naming Shepherd services that this service
+will depend on."
+   empty-serializer)
+
+  (user
+   (string "mympd")
+   "Owner of the @command{mympd} process."
+   empty-serializer)
+
+  (group
+   (string "nogroup")
+   "Owner group of the @command{mympd} process."
+   empty-serializer)
+
+  (work-directory
+   (string "/var/lib/mympd")
+   "Where myMPD will store its data."
+   empty-serializer)
+
+  (cache-directory
+   (string "/var/cache/mympd")
+   "Where myMPD will store its cache."
+   empty-serializer)
+
+  (acl
+   maybe-ip-acl
+   "ACL to access the myMPD webserver. See
+@uref{https://jcorporation.github.io/myMPD/configuration/acl,myMPD ACL}
+for syntax.")
+
+  (covercache-ttl
+   (maybe-integer 31)
+   "How long to keep cached covers, @code{0} disables cover caching.")
+
+  (http?
+   (boolean #t)
+   "HTTP support.")
+
+  (host
+   (string "[::]")
+   "Host name to listen on.")
+
+  (port
+   (maybe-port 80)
+   "HTTP port to listen on.")
+
+  (log-level
+   (integer 5)
+   "How much detail to include in logs, possible values: @code{0} to @code{7}.")
+
+  (log-to
+   (string-or-symbol "/var/log/mympd/log")
+   "Where to send logs. By default, the service logs to
+@file{/var/log/mympd.log}. The alternative is @code{'syslog}, which
+sends output to the running syslog service under the @samp{daemon} facility."
+   empty-serializer)
+
+  (lualibs
+   (maybe-string "all")
+   "See
+@url{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.")
+
+  (script-acl
+   (maybe-ip-acl (ip-acl
+                  (allow '("127.0.0.1"))))
+   "ACL to access the myMPD script backend.")
+
+  (ssl?
+   (boolean #f)
+   "SSL/TLS support.")
+
+  (ssl-port
+   (maybe-port 443)
+   "Port to listen for HTTPS.")
+
+  (ssl-cert
+   maybe-string
+   "Path to PEM encoded X.509 SSL/TLS certificate (public key).")
+
+  (ssl-key
+   maybe-string
+   "Path to PEM encoded SSL/TLS private key.")
+
+  (pin-hash
+   maybe-string
+   "SHA-256 hashed pin used by myMPD to control settings access by
+prompting a pin from the user."))
+
+(define (mympd-serialize-configuration config)
+  (define serialize-value
+    (match-lambda
+      ((? boolean? val) (if val "true" "false"))
+      ((or (? port? val) (? integer? val)) (number->string val))
+      ((? ip-acl? val) (ip-acl-serialize-configuration val))
+      ((? string? val) val)))
+
+  (define (ip-acl-serialize-configuration config)
+    (define (serialize-list-of-string prefix lst)
+      (map (cut format #f "~a~a" prefix <>) lst))
+    (string-join
+     (append
+      (serialize-list-of-string "+" (ip-acl-allow config))
+      (serialize-list-of-string "-" (ip-acl-deny config))) ","))
+
+  ;; myMPD configuration fields are serialized as individual files under
+  ;; <work-directory>/config/.
+  (match-record config <mympd-configuration> (work-directory acl
+                                              covercache-ttl http? host port
+                                              log-level lualibs script-acl
+                                              ssl? ssl-port ssl-cert ssl-key
+                                              pin-hash)
+    (define (serialize-field filename value)
+      (when (maybe-value-set? value)
+        (list (format #f "~a/config/~a" work-directory filename)
+              (mixed-text-file filename (serialize-value value)))))
+
+    (let ((filename-to-field `(("acl" . ,acl)
+                               ("covercache_keep_days" . ,covercache-ttl)
+                               ("http"                 . ,http?)
+                               ("http_host"            . ,host)
+                               ("http_port"            . ,port)
+                               ("loglevel"             . ,log-level)
+                               ("lualibs"              . ,lualibs)
+                               ("scriptacl"            . ,script-acl)
+                               ("ssl"                  . ,ssl?)
+                               ("ssl_port"             . ,ssl-port)
+                               ("ssl_cert"             . ,ssl-cert)
+                               ("ssl_key"              . ,ssl-key)
+                               ("pin_hash"             . ,pin-hash))))
+      (filter list?
+              (generic-serialize-alist list serialize-field
+                                       filename-to-field)))))
+
+(define (mympd-shepherd-service config)
+  (match-record config <mympd-configuration> (package shepherd-requirement
+                                              user work-directory
+                                              cache-directory log-level log-to)
+    (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level)))
+      (shepherd-service
+       (documentation "Run the myMPD daemon.")
+       (requirement `(loopback user-processes ,@shepherd-requirement))
+       (provision '(mympd))
+       (start #~(begin
+                  (let* ((pw (getpwnam #$user))
+                         (uid (passwd:uid pw))
+                         (gid (passwd:gid pw)))
+                    (for-each (lambda (dir)
+                                (mkdir-p dir)
+                                (chown dir uid gid))
+                              (list #$work-directory #$cache-directory)))
+
+                  (make-forkexec-constructor
+                   `(#$(file-append package "/bin/mympd")
+                     "--user" #$user
+                     #$@(if (eqv? log-to 'syslog) '("--syslog") '())
+                     "--workdir" #$work-directory
+                     "--cachedir" #$cache-directory)
+                   #:environment-variables (list #$log-level*)
+                   #:log-file #$(if (string? log-to) log-to #f))))
+       (stop #~(make-kill-destructor))))))
+
+(define (mympd-accounts config)
+  (match-record config <mympd-configuration> (user group)
+                (list (user-group (name group)
+                                  (system? #t))
+                      (user-account (name user)
+                                    (group group)
+                                    (system? #t)
+                                    (comment "myMPD user")
+                                    (home-directory "/var/empty")
+                                    (shell (file-append shadow "/sbin/nologin"))))))
+
+(define (mympd-log-rotation config)
+  (match-record config <mympd-configuration> (log-to)
+    (if (string? log-to)
+        (list (log-rotation
+               (files (list log-to))))
+        '())))
+
+(define mympd-service-type
+  (service-type
+   (name 'mympd)
+   (extensions
+    (list  (service-extension shepherd-root-service-type
+                              (compose list mympd-shepherd-service))
+           (service-extension account-service-type
+                              mympd-accounts)
+           (service-extension special-files-service-type
+                              mympd-serialize-configuration)
+           (service-extension rottlog-service-type
+                              mympd-log-rotation)))
+   (description "Run myMPD, a frontend for MPD. (Music Player Daemon)")
+   (default-value (mympd-configuration))))
diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm
index 8aa6d1e818..701496ee23 100644
--- a/gnu/tests/audio.scm
+++ b/gnu/tests/audio.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
+;;; Copyright © 2022 Bruno Victal <mirai <at> makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,9 +23,11 @@ (define-module (gnu tests audio)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services audio)
+  #:use-module (gnu services networking)
   #:use-module (gnu packages mpd)
   #:use-module (guix gexp)
-  #:export (%test-mpd))
+  #:export (%test-mpd
+            %test-mympd))
 
 (define %mpd-os
   (simple-operating-system
@@ -76,3 +79,52 @@ (define %test-mpd
    (name "mpd")
    (description "Test that the mpd can run and be connected to.")
    (value (run-mpd-test))))
+
+
+(define (run-mympd-test)
+  (define os (marionette-operating-system
+              (simple-operating-system (service dhcp-client-service-type)
+                                       (service mympd-service-type))
+              #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '((8080 . 80)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-64)
+                       (srfi srfi-8)
+                       (web client)
+                       (web response)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "mympd")
+          (test-assert "service is running"
+            (marionette-eval '(begin
+                                (use-modules (gnu services herd))
+
+                                (start-service 'mympd))
+                             marionette))
+
+          (test-assert "HTTP port ready"
+            (wait-for-tcp-port 80 marionette))
+
+          (test-equal "http-head"
+            200
+            (receive (x _) (http-head "http://localhost:8080") (response-code x)))
+
+          (test-end))))
+  (gexp->derivation "mympd-test" test))
+
+(define %test-mympd
+  (system-test
+   (name "mympd")
+   (description "Connect to a running myMPD service.")
+   (value (run-mympd-test))))

base-commit: 37fdb382dad47149d8f5be41af108478800e9d30
-- 
2.38.1





Information forwarded to guix-patches <at> gnu.org:
bug#61122; Package guix-patches. (Fri, 03 Feb 2023 22:49:01 GMT) Full text and rfc822 format available.

Message #8 received at 61122 <at> debbugs.gnu.org (full text, mbox):

From: Liliana Marie Prikler <liliana.prikler <at> gmail.com>
To: Bruno Victal <mirai <at> makinata.eu>, 61122 <at> debbugs.gnu.org
Subject: Re: [PATCH] services: Add mympd-service-type.
Date: Fri, 03 Feb 2023 23:48:47 +0100
Am Samstag, dem 28.01.2023 um 13:53 +0000 schrieb Bruno Victal:
> * gnu/services/audio.scm (mympd-service-type): New variable.
> * gnu/tests/audio.scm (%test-mympd): New variable.
> * doc/guix.texi: Document it.
> ---
>  doc/guix.texi          | 115 +++++++++++++++++
>  gnu/services/audio.scm | 273
> ++++++++++++++++++++++++++++++++++++++++-
>  gnu/tests/audio.scm    |  54 +++++++-
>  3 files changed, 440 insertions(+), 2 deletions(-)
> 
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 2b1ad77ba5..790696783c 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -112,6 +112,7 @@
>  Copyright @copyright{} 2022 Ivan Vilata-i-Balaguer@*
>  Copyright @copyright{} 2023 Giacomo Leidi@*
>  Copyright @copyright{} 2022 Antero Mejr@*
> +Copyright @copyright{} 2022 Bruno Victal@*
Are you sure it's still 2022?
>  
>  Permission is granted to copy, distribute and/or modify this
> document
>  under the terms of the GNU Free Documentation License, Version 1.3
> or
> @@ -33272,6 +33273,120 @@ Audio Services
>                          (port    . "8080"))))))))
>  @end lisp
>  
> +@subsubheading myMPD
> +
> +@cindex MPD, web interface
> +@cindex myMPD service
> +
> +@uref{https://jcorporation.github.io/myMPD/, myMPD} is a web server
> +frontend for MPD that provides a mobile friendly web client for MPD.
> +
> +The following example shows a myMPD instance listening on port 80,
> +with album cover caching disabled.
> +
> +@lisp
> +(service mympd-service-type
> +         (mympd-configuration
> +          (port 80)
> +          (covercache-ttl 0)))
> +@end lisp
> +
> +@defvar mympd-service-type
> +The service type for @command{mympd}.
> +@end defvar
> +
> +@c %start of fragment
> +@deftp {Data Type} mympd-configuration
> +Available @code{mympd-configuration} fields are:
> +
> +@table @asis
> +@item @code{package} (default: @code{mympd}) (type: file-like)
> +The package object of the myMPD server.
> +
> +@item @code{shepherd-requirement} (default: @code{()}) (type: list-
> of-symbol)
> +This is a list of symbols naming Shepherd services that this service
> +will depend on.
> +
> +@item @code{user} (default: @code{"mympd"}) (type: string)
> +Owner of the @command{mympd} process.
> +
> +@item @code{group} (default: @code{"nogroup"}) (type: string)
> +Owner group of the @command{mympd} process.
> +
> +@item @code{work-directory} (default: @code{"/var/lib/mympd"})
> (type: string)
> +Where myMPD will store its data.
> +
> +@item @code{cache-directory} (default: @code{"/var/cache/mympd"})
> (type: string)
> +Where myMPD will store its cache.
> +
> +@item @code{acl} (type: maybe-ip-acl)
> +ACL to access the myMPD webserver.  See
> +@uref{
> https://jcorporation.github.io/myMPD/configuration/acl,myMPD ACL}
> +for syntax.
> +
> +@item @code{covercache-ttl} (default: @code{31}) (type: maybe-
> integer)
> +How long to keep cached covers, @code{0} disables cover caching.
> +
> +@item @code{http?} (default: @code{#t}) (type: boolean)
> +HTTP support.
> +
> +@item @code{host} (default: @code{"[::]"}) (type: string)
> +Host name to listen on.
> +
> +@item @code{port} (default: @code{80}) (type: maybe-port)
> +HTTP port to listen on.
> +
> +@item @code{log-level} (default: @code{5}) (type: integer)
> +How much detail to include in logs, possible values: @code{0} to
> +@code{7}.
> +
> +@item @code{log-to} (default: @code{"/var/log/mympd/log"}) (type:
> string-or-symbol)
> +Where to send logs.  By default, the service logs to
> +@file{/var/log/mympd.log}.  The alternative is @code{'syslog}, which
> +sends output to the running syslog service under the @samp{daemon}
> +facility.
> +
> +@item @code{lualibs} (default: @code{"all"}) (type: maybe-string)
> +See
> +@uref{
> https://jcorporation.github.io/myMPD/scripting/#lua-standard-librarie
> s}.
> +
> +@item @code{script-acl} (default: @code{(ip-acl (allow
> '("127.0.0.1")))}) (type: maybe-ip-acl)
> +ACL to access the myMPD script backend.
> +
> +@item @code{ssl?} (default: @code{#f}) (type: boolean)
> +SSL/TLS support.
> +
> +@item @code{ssl-port} (default: @code{443}) (type: maybe-port)
> +Port to listen for HTTPS.
> +
> +@item @code{ssl-cert} (type: maybe-string)
> +Path to PEM encoded X.509 SSL/TLS certificate (public key).
> +
> +@item @code{ssl-key} (type: maybe-string)
> +Path to PEM encoded SSL/TLS private key.
> +
> +@item @code{pin-hash} (type: maybe-string)
> +SHA-256 hashed pin used by myMPD to control settings access by
> prompting
> +a pin from the user.
> +
> +@end table
> +@end deftp
> +@c %end of fragment
> +
> +@c %start of fragment
> +@deftp {Data Type} ip-acl
> +Available @code{ip-acl} fields are:
> +
> +@table @asis
> +@item @code{allow} (default: @code{()}) (type: list-of-string)
> +Allowed IP addresses.
> +
> +@item @code{deny} (default: @code{()}) (type: list-of-string)
> +Disallowed IP addresses.
> +
> +@end table
> +@end deftp
> +@c %end of fragment
>  
>  @node Virtualization Services
>  @subsection Virtualization Services
> diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
> index c60053f33c..c384d3d2b8 100644
> --- a/gnu/services/audio.scm
> +++ b/gnu/services/audio.scm
> @@ -2,6 +2,7 @@
>  ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
>  ;;; Copyright © 2019 Ricardo Wurmus <rekado <at> elephly.net>
>  ;;; Copyright © 2020 Ludovic Courtès <ludo <at> gnu.org>
> +;;; Copyright © 2022 Bruno Victal <mirai <at> makinata.eu>
Same here.
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -21,6 +22,8 @@
>  (define-module (gnu services audio)
>    #:use-module (guix gexp)
>    #:use-module (gnu services)
> +  #:use-module (gnu services admin)
> +  #:use-module (gnu services configuration)
>    #:use-module (gnu services shepherd)
>    #:use-module (gnu system shadow)
>    #:use-module (gnu packages admin)
> @@ -28,11 +31,41 @@ (define-module (gnu services audio)
>    #:use-module (guix records)
>    #:use-module (ice-9 match)
>    #:use-module (ice-9 format)
> +  #:use-module (srfi srfi-1)
> +  #:use-module (srfi srfi-26)
>    #:export (mpd-output
>              mpd-output?
>              mpd-configuration
>              mpd-configuration?
> -            mpd-service-type))
> +            mpd-service-type
> +
> +            mympd-service-type
> +            mympd-configuration
> +            mympd-configuration?
> +            mympd-configuration-package
> +            mympd-configuration-shepherd-requirement
> +            mympd-configuration-user
> +            mympd-configuration-group
> +            mympd-configuration-work-directory
> +            mympd-configuration-cache-directory
> +            mympd-configuration-acl
> +            mympd-configuration-covercache-ttl
> +            mympd-configuration-http?
> +            mympd-configuration-host
> +            mympd-configuration-port
> +            mympd-configuration-log-level
> +            mympd-configuration-log-to
> +            mympd-configuration-lualibs
> +            mympd-configuration-script-acl
> +            mympd-configuration-ssl?
> +            mympd-configuration-ssl-port
> +            mympd-configuration-ssl-cert
> +            mympd-configuration-ssl-key
> +            mympd-configuration-pin-hash
> +            ip-acl
> +            ip-acl?
> +            ip-acl-allow
> +            ip-acl-deny))
This should probably be mympd-ip-acl*
>  
>  ;;; Commentary:
>  ;;;
> @@ -197,3 +230,241 @@ (define mpd-service-type
>            (service-extension activation-service-type
>                               mpd-service-activation)))
>     (default-value (mpd-configuration))))
> +
> +
> +;;;
> +;;; myMPD
> +;;;
> +
> +(define list-of-symbol?
> +  (list-of symbol?))
> +
> +(define list-of-string?
> +  (list-of string?))
> +
> +(define (port? n)
> +  (and (integer? n)
> +       (<= 0 n 65535)))
> +
> +(define (string-or-symbol? x)
> +  (or (symbol? x) (string? x)))
> +
> +(define-configuration/no-serialization ip-acl
> +  (allow
> +   (list-of-string '())
> +   "Allowed IP addresses.")
> +
> +  (deny
> +   (list-of-string '())
> +   "Disallowed IP addresses."))
> +
> +(define-maybe/no-serialization port)
> +(define-maybe/no-serialization integer)
> +(define-maybe/no-serialization string)
> +(define-maybe/no-serialization ip-acl)
> +
> +;; XXX: The serialization procedures are insufficient since we
> require
> +;; access to multiple fields at once.
> +;; Fields marked with empty-serializer are never serialized and are
> +;; used for command-line arguments or by the service definition.
> +(define-configuration/no-serialization mympd-configuration
> +  (package
> +    (file-like mympd)
> +    "The package object of the myMPD server."
> +    empty-serializer)
> +
> +  (shepherd-requirement
> +   (list-of-symbol '())
> +   "This is a list of symbols naming Shepherd services that this
> service
> +will depend on."
> +   empty-serializer)
> +
> +  (user
> +   (string "mympd")
> +   "Owner of the @command{mympd} process."
> +   empty-serializer)
> +
> +  (group
> +   (string "nogroup")
> +   "Owner group of the @command{mympd} process."
> +   empty-serializer)
> +
> +  (work-directory
> +   (string "/var/lib/mympd")
> +   "Where myMPD will store its data."
> +   empty-serializer)
> +
> +  (cache-directory
> +   (string "/var/cache/mympd")
> +   "Where myMPD will store its cache."
> +   empty-serializer)
> +
> +  (acl
> +   maybe-ip-acl
> +   "ACL to access the myMPD webserver. See
> +@uref{
> https://jcorporation.github.io/myMPD/configuration/acl,myMPD ACL}
> +for syntax.")
> +
> +  (covercache-ttl
> +   (maybe-integer 31)
> +   "How long to keep cached covers, @code{0} disables cover
> caching.")
> +
> +  (http?
> +   (boolean #t)
> +   "HTTP support.")
> +
> +  (host
> +   (string "[::]")
> +   "Host name to listen on.")
> +
> +  (port
> +   (maybe-port 80)
> +   "HTTP port to listen on.")
> +
> +  (log-level
> +   (integer 5)
> +   "How much detail to include in logs, possible values: @code{0} to
> @code{7}.")
> +
> +  (log-to
> +   (string-or-symbol "/var/log/mympd/log")
> +   "Where to send logs. By default, the service logs to
> +@file{/var/log/mympd.log}. The alternative is @code{'syslog}, which
> +sends output to the running syslog service under the @samp{daemon}
> facility."
> +   empty-serializer)
> +
> +  (lualibs
> +   (maybe-string "all")
> +   "See
> +@url{
> https://jcorporation.github.io/myMPD/scripting/#lua-standard-librarie
> s}.")
> +
> +  (script-acl
> +   (maybe-ip-acl (ip-acl
> +                  (allow '("127.0.0.1"))))
> +   "ACL to access the myMPD script backend.")
> +
> +  (ssl?
> +   (boolean #f)
> +   "SSL/TLS support.")
> +
> +  (ssl-port
> +   (maybe-port 443)
> +   "Port to listen for HTTPS.")
> +
> +  (ssl-cert
> +   maybe-string
> +   "Path to PEM encoded X.509 SSL/TLS certificate (public key).")
> +
> +  (ssl-key
> +   maybe-string
> +   "Path to PEM encoded SSL/TLS private key.")
> +
> +  (pin-hash
> +   maybe-string
> +   "SHA-256 hashed pin used by myMPD to control settings access by
> +prompting a pin from the user."))
> +
> +(define (mympd-serialize-configuration config)
> +  (define serialize-value
> +    (match-lambda
> +      ((? boolean? val) (if val "true" "false"))
> +      ((or (? port? val) (? integer? val)) (number->string val))
> +      ((? ip-acl? val) (ip-acl-serialize-configuration val))
> +      ((? string? val) val)))
> +
> +  (define (ip-acl-serialize-configuration config)
> +    (define (serialize-list-of-string prefix lst)
> +      (map (cut format #f "~a~a" prefix <>) lst))
> +    (string-join
> +     (append
> +      (serialize-list-of-string "+" (ip-acl-allow config))
> +      (serialize-list-of-string "-" (ip-acl-deny config))) ","))
> +
> +  ;; myMPD configuration fields are serialized as individual files
> under
> +  ;; <work-directory>/config/.
> +  (match-record config <mympd-configuration> (work-directory acl
> +                                              covercache-ttl http?
> host port
> +                                              log-level lualibs
> script-acl
> +                                              ssl? ssl-port ssl-cert
> ssl-key
> +                                              pin-hash)
> +    (define (serialize-field filename value)
> +      (when (maybe-value-set? value)
> +        (list (format #f "~a/config/~a" work-directory filename)
> +              (mixed-text-file filename (serialize-value value)))))
> +
> +    (let ((filename-to-field `(("acl" . ,acl)
> +                               ("covercache_keep_days" .
> ,covercache-ttl)
> +                               ("http"                 . ,http?)
> +                               ("http_host"            . ,host)
> +                               ("http_port"            . ,port)
> +                               ("loglevel"             . ,log-level)
> +                               ("lualibs"              . ,lualibs)
> +                               ("scriptacl"            . ,script-
> acl)
> +                               ("ssl"                  . ,ssl?)
> +                               ("ssl_port"             . ,ssl-port)
> +                               ("ssl_cert"             . ,ssl-cert)
> +                               ("ssl_key"              . ,ssl-key)
> +                               ("pin_hash"             . ,pin-
> hash))))
> +      (filter list?
> +              (generic-serialize-alist list serialize-field
> +                                       filename-to-field)))))
> +
> +(define (mympd-shepherd-service config)
> +  (match-record config <mympd-configuration> (package shepherd-
> requirement
> +                                              user work-directory
> +                                              cache-directory log-
> level log-to)
> +    (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level)))
> +      (shepherd-service
> +       (documentation "Run the myMPD daemon.")
> +       (requirement `(loopback user-processes ,@shepherd-
> requirement))
> +       (provision '(mympd))
> +       (start #~(begin
> +                  (let* ((pw (getpwnam #$user))
> +                         (uid (passwd:uid pw))
> +                         (gid (passwd:gid pw)))
> +                    (for-each (lambda (dir)
> +                                (mkdir-p dir)
> +                                (chown dir uid gid))
> +                              (list #$work-directory #$cache-
> directory)))
> +
> +                  (make-forkexec-constructor
> +                   `(#$(file-append package "/bin/mympd")
> +                     "--user" #$user
> +                     #$@(if (eqv? log-to 'syslog) '("--syslog") '())
> +                     "--workdir" #$work-directory
> +                     "--cachedir" #$cache-directory)
> +                   #:environment-variables (list #$log-level*)
> +                   #:log-file #$(if (string? log-to) log-to #f))))
> +       (stop #~(make-kill-destructor))))))
> +
> +(define (mympd-accounts config)
> +  (match-record config <mympd-configuration> (user group)
> +                (list (user-group (name group)
> +                                  (system? #t))
> +                      (user-account (name user)
> +                                    (group group)
> +                                    (system? #t)
> +                                    (comment "myMPD user")
> +                                    (home-directory "/var/empty")
> +                                    (shell (file-append shadow
> "/sbin/nologin"))))))
> +
> +(define (mympd-log-rotation config)
> +  (match-record config <mympd-configuration> (log-to)
> +    (if (string? log-to)
> +        (list (log-rotation
> +               (files (list log-to))))
> +        '())))
> +
> +(define mympd-service-type
> +  (service-type
> +   (name 'mympd)
> +   (extensions
> +    (list  (service-extension shepherd-root-service-type
> +                              (compose list mympd-shepherd-service))
> +           (service-extension account-service-type
> +                              mympd-accounts)
> +           (service-extension special-files-service-type
> +                              mympd-serialize-configuration)
> +           (service-extension rottlog-service-type
> +                              mympd-log-rotation)))
> +   (description "Run myMPD, a frontend for MPD. (Music Player
> Daemon)")
> +   (default-value (mympd-configuration))))
> diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm
> index 8aa6d1e818..701496ee23 100644
> --- a/gnu/tests/audio.scm
> +++ b/gnu/tests/audio.scm
> @@ -1,5 +1,6 @@
>  ;;; GNU Guix --- Functional package management for GNU
>  ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
> +;;; Copyright © 2022 Bruno Victal <mirai <at> makinata.eu>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -22,9 +23,11 @@ (define-module (gnu tests audio)
>    #:use-module (gnu system vm)
>    #:use-module (gnu services)
>    #:use-module (gnu services audio)
> +  #:use-module (gnu services networking)
>    #:use-module (gnu packages mpd)
>    #:use-module (guix gexp)
> -  #:export (%test-mpd))
> +  #:export (%test-mpd
> +            %test-mympd))
>  
>  (define %mpd-os
>    (simple-operating-system
> @@ -76,3 +79,52 @@ (define %test-mpd
>     (name "mpd")
>     (description "Test that the mpd can run and be connected to.")
>     (value (run-mpd-test))))
> +
> +
> +(define (run-mympd-test)
> +  (define os (marionette-operating-system
> +              (simple-operating-system (service dhcp-client-service-
> type)
> +                                       (service mympd-service-type))
> +              #:imported-modules '((gnu services herd))))
> +
> +  (define vm
> +    (virtual-machine
> +     (operating-system os)
> +     (port-forwardings '((8080 . 80)))))
> +
> +  (define test
> +    (with-imported-modules '((gnu build marionette))
> +      #~(begin
> +          (use-modules (srfi srfi-64)
> +                       (srfi srfi-8)
> +                       (web client)
> +                       (web response)
> +                       (gnu build marionette))
> +
> +          (define marionette
> +            (make-marionette (list #$vm)))
> +
> +          (test-runner-current (system-test-runner #$output))
> +          (test-begin "mympd")
> +          (test-assert "service is running"
> +            (marionette-eval '(begin
> +                                (use-modules (gnu services herd))
> +
> +                                (start-service 'mympd))
> +                             marionette))
> +
> +          (test-assert "HTTP port ready"
> +            (wait-for-tcp-port 80 marionette))
> +
> +          (test-equal "http-head"
> +            200
> +            (receive (x _) (http-head "http://localhost:8080")
> (response-code x)))
> +
> +          (test-end))))
> +  (gexp->derivation "mympd-test" test))
> +
> +(define %test-mympd
> +  (system-test
> +   (name "mympd")
> +   (description "Connect to a running myMPD service.")
> +   (value (run-mympd-test))))
> 
> base-commit: 37fdb382dad47149d8f5be41af108478800e9d30
Cheers

Information forwarded to guix-patches <at> gnu.org:
bug#61122; Package guix-patches. (Sat, 04 Feb 2023 00:29:02 GMT) Full text and rfc822 format available.

Message #11 received at 61122 <at> debbugs.gnu.org (full text, mbox):

From: Bruno Victal <mirai <at> makinata.eu>
To: Liliana Marie Prikler <liliana.prikler <at> gmail.com>
Cc: 61122 <at> debbugs.gnu.org
Subject: Re: [PATCH] services: Add mympd-service-type.
Date: Sat, 4 Feb 2023 00:28:13 +0000
On 2023-02-03 22:48, Liliana Marie Prikler wrote:
> Am Samstag, dem 28.01.2023 um 13:53 +0000 schrieb Bruno Victal:
>>  Copyright @copyright{} 2022 Antero Mejr@*
>> +Copyright @copyright{} 2022 Bruno Victal@*
> Are you sure it's still 2022?

The code for this service was laid down in 2022 and although it has
been refactored since, I'd prefer to keep its original date.


Cheers,
Bruno




Information forwarded to guix-patches <at> gnu.org:
bug#61122; Package guix-patches. (Sat, 04 Feb 2023 20:29:02 GMT) Full text and rfc822 format available.

Message #14 received at 61122 <at> debbugs.gnu.org (full text, mbox):

From: Bruno Victal <mirai <at> makinata.eu>
To: 61122 <at> debbugs.gnu.org
Cc: Bruno Victal <mirai <at> makinata.eu>, liliana.prikler <at> gmail.com
Subject: [PATCH v2] services: Add mympd-service-type.
Date: Sat,  4 Feb 2023 20:28:16 +0000
* gnu/services/audio.scm (mympd-service-type): New variable.
* gnu/tests/audio.scm (%test-mympd): New variable.
* doc/guix.texi: Document it.
---

Notable changes since v1:
  * renamed ip-acl to mympd-ip-acl.
  * added uri and save-caches? field (recently added upstream options)

 doc/guix.texi          | 120 +++++++++++++++++
 gnu/services/audio.scm | 285 ++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/audio.scm    |  54 +++++++-
 3 files changed, 457 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index d69be8586e..ea31f313f9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -112,6 +112,7 @@
 Copyright @copyright{} 2022 Ivan Vilata-i-Balaguer@*
 Copyright @copyright{} 2023 Giacomo Leidi@*
 Copyright @copyright{} 2022 Antero Mejr@*
+Copyright @copyright{} 2022 Bruno Victal@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -33272,6 +33273,125 @@ Audio Services
                         (port    . "8080"))))))))
 @end lisp
 
+@subsubheading myMPD
+
+@cindex MPD, web interface
+@cindex myMPD service
+
+@uref{https://jcorporation.github.io/myMPD/, myMPD} is a web server
+frontend for MPD that provides a mobile friendly web client for MPD.
+
+The following example shows a myMPD instance listening on port 80,
+with album cover caching disabled.
+
+@lisp
+(service mympd-service-type
+         (mympd-configuration
+          (port 80)
+          (covercache-ttl 0)))
+@end lisp
+
+@defvar mympd-service-type
+The service type for @command{mympd}.
+@end defvar
+
+@c %start of fragment
+@deftp {Data Type} mympd-configuration
+Available @code{mympd-configuration} fields are:
+
+@table @asis
+@item @code{package} (default: @code{mympd}) (type: file-like)
+The package object of the myMPD server.
+
+@item @code{shepherd-requirement} (default: @code{()}) (type: list-of-symbol)
+This is a list of symbols naming Shepherd services that this service
+will depend on.
+
+@item @code{user} (default: @code{"mympd"}) (type: string)
+Owner of the @command{mympd} process.
+
+@item @code{group} (default: @code{"nogroup"}) (type: string)
+Owner group of the @command{mympd} process.
+
+@item @code{work-directory} (default: @code{"/var/lib/mympd"}) (type: string)
+Where myMPD will store its data.
+
+@item @code{cache-directory} (default: @code{"/var/cache/mympd"}) (type: string)
+Where myMPD will store its cache.
+
+@item @code{acl} (type: maybe-mympd-ip-acl)
+ACL to access the myMPD webserver.
+
+@item @code{covercache-ttl} (default: @code{31}) (type: maybe-integer)
+How long to keep cached covers, @code{0} disables cover caching.
+
+@item @code{http?} (default: @code{#t}) (type: boolean)
+HTTP support.
+
+@item @code{host} (default: @code{"[::]"}) (type: string)
+Host name to listen on.
+
+@item @code{port} (default: @code{80}) (type: maybe-port)
+HTTP port to listen on.
+
+@item @code{log-level} (default: @code{5}) (type: integer)
+How much detail to include in logs, possible values: @code{0} to
+@code{7}.
+
+@item @code{log-to} (default: @code{"/var/log/mympd/log"}) (type: string-or-symbol)
+Where to send logs.  By default, the service logs to
+@file{/var/log/mympd.log}.  The alternative is @code{'syslog}, which
+sends output to the running syslog service under the @samp{daemon}
+facility.
+
+@item @code{lualibs} (default: @code{"all"}) (type: maybe-string)
+See
+@uref{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.
+
+@item @code{uri} (type: maybe-string)
+Override URI to myMPD.  See
+@uref{https://github.com/jcorporation/myMPD/issues/950}.
+
+@item @code{script-acl} (default: @code{(mympd-ip-acl (allow '("127.0.0.1")))}) (type: maybe-mympd-ip-acl)
+ACL to access the myMPD script backend.
+
+@item @code{ssl?} (default: @code{#f}) (type: boolean)
+SSL/TLS support.
+
+@item @code{ssl-port} (default: @code{443}) (type: maybe-port)
+Port to listen for HTTPS.
+
+@item @code{ssl-cert} (type: maybe-string)
+Path to PEM encoded X.509 SSL/TLS certificate (public key).
+
+@item @code{ssl-key} (type: maybe-string)
+Path to PEM encoded SSL/TLS private key.
+
+@item @code{pin-hash} (type: maybe-string)
+SHA-256 hashed pin used by myMPD to control settings access by prompting
+a pin from the user.
+
+@item @code{save-caches?} (type: maybe-boolean)
+Whether to preserve caches between service restarts.
+
+@end table
+@end deftp
+@c %end of fragment
+
+@c %start of fragment
+@deftp {Data Type} mympd-ip-acl
+Available @code{mympd-ip-acl} fields are:
+
+@table @asis
+@item @code{allow} (default: @code{()}) (type: list-of-string)
+Allowed IP addresses.
+
+@item @code{deny} (default: @code{()}) (type: list-of-string)
+Disallowed IP addresses.
+
+@end table
+@end deftp
+@c %end of fragment
 
 @node Virtualization Services
 @subsection Virtualization Services
diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index c60053f33c..3cb4b6f9bf 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2020 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2022 Bruno Victal <mirai <at> makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,8 @@
 (define-module (gnu services audio)
   #:use-module (guix gexp)
   #:use-module (gnu services)
+  #:use-module (gnu services admin)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages admin)
@@ -28,11 +31,43 @@ (define-module (gnu services audio)
   #:use-module (guix records)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (mpd-output
             mpd-output?
             mpd-configuration
             mpd-configuration?
-            mpd-service-type))
+            mpd-service-type
+
+            mympd-service-type
+            mympd-configuration
+            mympd-configuration?
+            mympd-configuration-package
+            mympd-configuration-shepherd-requirement
+            mympd-configuration-user
+            mympd-configuration-group
+            mympd-configuration-work-directory
+            mympd-configuration-cache-directory
+            mympd-configuration-acl
+            mympd-configuration-covercache-ttl
+            mympd-configuration-http?
+            mympd-configuration-host
+            mympd-configuration-port
+            mympd-configuration-log-level
+            mympd-configuration-log-to
+            mympd-configuration-lualibs
+            mympd-configuration-uri
+            mympd-configuration-script-acl
+            mympd-configuration-ssl?
+            mympd-configuration-ssl-port
+            mympd-configuration-ssl-cert
+            mympd-configuration-ssl-key
+            mympd-configuration-pin-hash
+            mympd-configuration-save-caches?
+            mympd-ip-acl
+            mympd-ip-acl?
+            mympd-ip-acl-allow
+            mympd-ip-acl-deny))
 
 ;;; Commentary:
 ;;;
@@ -197,3 +232,251 @@ (define mpd-service-type
           (service-extension activation-service-type
                              mpd-service-activation)))
    (default-value (mpd-configuration))))
+
+
+;;;
+;;; myMPD
+;;;
+
+(define list-of-symbol?
+  (list-of symbol?))
+
+(define list-of-string?
+  (list-of string?))
+
+(define (port? n)
+  (and (integer? n)
+       (<= 0 n 65535)))
+
+(define (string-or-symbol? x)
+  (or (symbol? x) (string? x)))
+
+(define-configuration/no-serialization mympd-ip-acl
+  (allow
+   (list-of-string '())
+   "Allowed IP addresses.")
+
+  (deny
+   (list-of-string '())
+   "Disallowed IP addresses."))
+
+(define-maybe/no-serialization port)
+(define-maybe/no-serialization boolean)
+(define-maybe/no-serialization integer)
+(define-maybe/no-serialization string)
+(define-maybe/no-serialization mympd-ip-acl)
+
+;; XXX: The serialization procedures are insufficient since we require
+;; access to multiple fields at once.
+;; Fields marked with empty-serializer are never serialized and are
+;; used for command-line arguments or by the service definition.
+(define-configuration/no-serialization mympd-configuration
+  (package
+    (file-like mympd)
+    "The package object of the myMPD server."
+    empty-serializer)
+
+  (shepherd-requirement
+   (list-of-symbol '())
+   "This is a list of symbols naming Shepherd services that this service
+will depend on."
+   empty-serializer)
+
+  (user
+   (string "mympd")
+   "Owner of the @command{mympd} process."
+   empty-serializer)
+
+  (group
+   (string "nogroup")
+   "Owner group of the @command{mympd} process."
+   empty-serializer)
+
+  (work-directory
+   (string "/var/lib/mympd")
+   "Where myMPD will store its data."
+   empty-serializer)
+
+  (cache-directory
+   (string "/var/cache/mympd")
+   "Where myMPD will store its cache."
+   empty-serializer)
+
+  (acl
+   maybe-mympd-ip-acl
+   "ACL to access the myMPD webserver.")
+
+  (covercache-ttl
+   (maybe-integer 31)
+   "How long to keep cached covers, @code{0} disables cover caching.")
+
+  (http?
+   (boolean #t)
+   "HTTP support.")
+
+  (host
+   (string "[::]")
+   "Host name to listen on.")
+
+  (port
+   (maybe-port 80)
+   "HTTP port to listen on.")
+
+  (log-level
+   (integer 5)
+   "How much detail to include in logs, possible values: @code{0} to @code{7}.")
+
+  (log-to
+   (string-or-symbol "/var/log/mympd/log")
+   "Where to send logs. By default, the service logs to
+@file{/var/log/mympd.log}. The alternative is @code{'syslog}, which
+sends output to the running syslog service under the @samp{daemon} facility."
+   empty-serializer)
+
+  (lualibs
+   (maybe-string "all")
+   "See
+@url{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.")
+
+  (uri
+   maybe-string
+   "Override URI to myMPD.
+See @url{https://github.com/jcorporation/myMPD/issues/950}.")
+
+  (script-acl
+   (maybe-mympd-ip-acl (mympd-ip-acl
+                        (allow '("127.0.0.1"))))
+   "ACL to access the myMPD script backend.")
+
+  (ssl?
+   (boolean #f)
+   "SSL/TLS support.")
+
+  (ssl-port
+   (maybe-port 443)
+   "Port to listen for HTTPS.")
+
+  (ssl-cert
+   maybe-string
+   "Path to PEM encoded X.509 SSL/TLS certificate (public key).")
+
+  (ssl-key
+   maybe-string
+   "Path to PEM encoded SSL/TLS private key.")
+
+  (pin-hash
+   maybe-string
+   "SHA-256 hashed pin used by myMPD to control settings access by
+prompting a pin from the user.")
+
+  (save-caches?
+   maybe-boolean
+   "Whether to preserve caches between service restarts."))
+
+(define (mympd-serialize-configuration config)
+  (define serialize-value
+    (match-lambda
+      ((? boolean? val) (if val "true" "false"))
+      ((or (? port? val) (? integer? val)) (number->string val))
+      ((? mympd-ip-acl? val) (ip-acl-serialize-configuration val))
+      ((? string? val) val)))
+
+  (define (ip-acl-serialize-configuration config)
+    (define (serialize-list-of-string prefix lst)
+      (map (cut format #f "~a~a" prefix <>) lst))
+    (string-join
+     (append
+      (serialize-list-of-string "+" (mympd-ip-acl-allow config))
+      (serialize-list-of-string "-" (mympd-ip-acl-deny config))) ","))
+
+  ;; myMPD configuration fields are serialized as individual files under
+  ;; <work-directory>/config/.
+  (match-record config <mympd-configuration> (work-directory acl
+                                              covercache-ttl http? host port
+                                              log-level lualibs uri script-acl
+                                              ssl? ssl-port ssl-cert ssl-key
+                                              pin-hash save-caches?)
+    (define (serialize-field filename value)
+      (when (maybe-value-set? value)
+        (list (format #f "~a/config/~a" work-directory filename)
+              (mixed-text-file filename (serialize-value value)))))
+
+    (let ((filename-to-field `(("acl" . ,acl)
+                               ("covercache_keep_days" . ,covercache-ttl)
+                               ("http"                 . ,http?)
+                               ("http_host"            . ,host)
+                               ("http_port"            . ,port)
+                               ("loglevel"             . ,log-level)
+                               ("lualibs"              . ,lualibs)
+                               ("mympd_uri"            . ,uri)
+                               ("scriptacl"            . ,script-acl)
+                               ("ssl"                  . ,ssl?)
+                               ("ssl_port"             . ,ssl-port)
+                               ("ssl_cert"             . ,ssl-cert)
+                               ("ssl_key"              . ,ssl-key)
+                               ("pin_hash"             . ,pin-hash)
+                               ("save_caches"          . ,save-caches?))))
+      (filter list?
+              (generic-serialize-alist list serialize-field
+                                       filename-to-field)))))
+
+(define (mympd-shepherd-service config)
+  (match-record config <mympd-configuration> (package shepherd-requirement
+                                              user work-directory
+                                              cache-directory log-level log-to)
+    (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level)))
+      (shepherd-service
+       (documentation "Run the myMPD daemon.")
+       (requirement `(loopback user-processes ,@shepherd-requirement))
+       (provision '(mympd))
+       (start #~(begin
+                  (let* ((pw (getpwnam #$user))
+                         (uid (passwd:uid pw))
+                         (gid (passwd:gid pw)))
+                    (for-each (lambda (dir)
+                                (mkdir-p dir)
+                                (chown dir uid gid))
+                              (list #$work-directory #$cache-directory)))
+
+                  (make-forkexec-constructor
+                   `(#$(file-append package "/bin/mympd")
+                     "--user" #$user
+                     #$@(if (eqv? log-to 'syslog) '("--syslog") '())
+                     "--workdir" #$work-directory
+                     "--cachedir" #$cache-directory)
+                   #:environment-variables (list #$log-level*)
+                   #:log-file #$(if (string? log-to) log-to #f))))
+       (stop #~(make-kill-destructor))))))
+
+(define (mympd-accounts config)
+  (match-record config <mympd-configuration> (user group)
+                (list (user-group (name group)
+                                  (system? #t))
+                      (user-account (name user)
+                                    (group group)
+                                    (system? #t)
+                                    (comment "myMPD user")
+                                    (home-directory "/var/empty")
+                                    (shell (file-append shadow "/sbin/nologin"))))))
+
+(define (mympd-log-rotation config)
+  (match-record config <mympd-configuration> (log-to)
+    (if (string? log-to)
+        (list (log-rotation
+               (files (list log-to))))
+        '())))
+
+(define mympd-service-type
+  (service-type
+   (name 'mympd)
+   (extensions
+    (list  (service-extension shepherd-root-service-type
+                              (compose list mympd-shepherd-service))
+           (service-extension account-service-type
+                              mympd-accounts)
+           (service-extension special-files-service-type
+                              mympd-serialize-configuration)
+           (service-extension rottlog-service-type
+                              mympd-log-rotation)))
+   (description "Run myMPD, a frontend for MPD. (Music Player Daemon)")
+   (default-value (mympd-configuration))))
diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm
index 8aa6d1e818..701496ee23 100644
--- a/gnu/tests/audio.scm
+++ b/gnu/tests/audio.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10 <at> gmail.com>
+;;; Copyright © 2022 Bruno Victal <mirai <at> makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,9 +23,11 @@ (define-module (gnu tests audio)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services audio)
+  #:use-module (gnu services networking)
   #:use-module (gnu packages mpd)
   #:use-module (guix gexp)
-  #:export (%test-mpd))
+  #:export (%test-mpd
+            %test-mympd))
 
 (define %mpd-os
   (simple-operating-system
@@ -76,3 +79,52 @@ (define %test-mpd
    (name "mpd")
    (description "Test that the mpd can run and be connected to.")
    (value (run-mpd-test))))
+
+
+(define (run-mympd-test)
+  (define os (marionette-operating-system
+              (simple-operating-system (service dhcp-client-service-type)
+                                       (service mympd-service-type))
+              #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '((8080 . 80)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-64)
+                       (srfi srfi-8)
+                       (web client)
+                       (web response)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "mympd")
+          (test-assert "service is running"
+            (marionette-eval '(begin
+                                (use-modules (gnu services herd))
+
+                                (start-service 'mympd))
+                             marionette))
+
+          (test-assert "HTTP port ready"
+            (wait-for-tcp-port 80 marionette))
+
+          (test-equal "http-head"
+            200
+            (receive (x _) (http-head "http://localhost:8080") (response-code x)))
+
+          (test-end))))
+  (gexp->derivation "mympd-test" test))
+
+(define %test-mympd
+  (system-test
+   (name "mympd")
+   (description "Connect to a running myMPD service.")
+   (value (run-mympd-test))))
-- 
2.38.1





Reply sent to Liliana Marie Prikler <liliana.prikler <at> gmail.com>:
You have taken responsibility. (Sun, 05 Feb 2023 06:12:02 GMT) Full text and rfc822 format available.

Notification sent to Bruno Victal <mirai <at> makinata.eu>:
bug acknowledged by developer. (Sun, 05 Feb 2023 06:12:03 GMT) Full text and rfc822 format available.

Message #19 received at 61122-done <at> debbugs.gnu.org (full text, mbox):

From: Liliana Marie Prikler <liliana.prikler <at> gmail.com>
To: Bruno Victal <mirai <at> makinata.eu>, 61122-done <at> debbugs.gnu.org
Subject: Re: [PATCH v2] services: Add mympd-service-type.
Date: Sun, 05 Feb 2023 07:11:38 +0100
Am Samstag, dem 04.02.2023 um 20:28 +0000 schrieb Bruno Victal:
> * gnu/services/audio.scm (mympd-service-type): New variable.
> * gnu/tests/audio.scm (%test-mympd): New variable.
> * doc/guix.texi: Document it.
Rebased on top of mpd-service-type and pushed.

Cheers




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Sun, 05 Mar 2023 12:24:06 GMT) Full text and rfc822 format available.

This bug report was last modified 1 year and 46 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.