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

[Liliana Marie Prikler <liliana.prikler@gmail.com>]

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))))
> +
> +\f
> +;;;
> +;;; 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