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.
View this message in rfc822 format
From: Liliana Marie Prikler <liliana.prikler <at> gmail.com> To: Bruno Victal <mirai <at> makinata.eu>, 61122 <at> debbugs.gnu.org Subject: [bug#61122] [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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.