[bug#61122] services: Add mympd-service-type.

* 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(-)


base-commit: 37fdb382dad47149d8f5be41af108478800e9d30

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@gmail.com>
>  ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
>  ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
> +;;; Copyright © 2022 Bruno Victal <mirai@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@gmail.com>
> +;;; Copyright © 2022 Bruno Victal <mirai@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

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