From patchwork Sat Jan 28 13:53:43 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Bruno Victal X-Patchwork-Id: 46487 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 2D4AC27BBED; Sat, 28 Jan 2023 13:55:21 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7CEB627BBE9 for ; Sat, 28 Jan 2023 13:55:18 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pLlfd-0000S2-59; Sat, 28 Jan 2023 08:55:05 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pLlfa-0000Rk-Nk for guix-patches@gnu.org; Sat, 28 Jan 2023 08:55:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pLlfa-0007EZ-0v for guix-patches@gnu.org; Sat, 28 Jan 2023 08:55:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pLlfZ-0007yx-Na for guix-patches@gnu.org; Sat, 28 Jan 2023 08:55:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61122] [PATCH] services: Add mympd-service-type. Resent-From: Bruno Victal Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 28 Jan 2023 13:55:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 61122 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61122@debbugs.gnu.org Cc: Bruno Victal X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.167491405530618 (code B ref -1); Sat, 28 Jan 2023 13:55:01 +0000 Received: (at submit) by debbugs.gnu.org; 28 Jan 2023 13:54:15 +0000 Received: from localhost ([127.0.0.1]:39904 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pLleo-0007xl-5G for submit@debbugs.gnu.org; Sat, 28 Jan 2023 08:54:15 -0500 Received: from lists.gnu.org ([209.51.188.17]:60914) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pLlel-0007xd-TD for submit@debbugs.gnu.org; Sat, 28 Jan 2023 08:54:13 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pLlel-0000PV-Lt for guix-patches@gnu.org; Sat, 28 Jan 2023 08:54:11 -0500 Received: from smtpm1.myservices.hosting ([185.26.105.232]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pLlei-0007Ap-VG for guix-patches@gnu.org; Sat, 28 Jan 2023 08:54:11 -0500 Received: from mail1.netim.hosting (unknown [185.26.106.172]) by smtpm1.myservices.hosting (Postfix) with ESMTP id 31CC720865 for ; Sat, 28 Jan 2023 14:53:57 +0100 (CET) Received: from localhost (localhost [127.0.0.1]) by mail1.netim.hosting (Postfix) with ESMTP id CAEA380098; Sat, 28 Jan 2023 14:53:57 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mail1.netim.hosting Received: from mail1.netim.hosting ([127.0.0.1]) by localhost (mail1-1.netim.hosting [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id 1UlGWltVrFiE; Sat, 28 Jan 2023 14:53:53 +0100 (CET) Received: from guix-nuc.home.arpa (bl9-118-236.dsl.telepac.pt [85.242.118.236]) (Authenticated sender: lumen@makinata.eu) by mail1.netim.hosting (Postfix) with ESMTPSA id ED0A380097; Sat, 28 Jan 2023 14:53:52 +0100 (CET) From: Bruno Victal Date: Sat, 28 Jan 2023 13:53:43 +0000 Message-Id: <26049376dd4cec9bb473fa889b73409bc71b14ba.1674913975.git.mirai@makinata.eu> X-Mailer: git-send-email 2.38.1 MIME-Version: 1.0 Received-SPF: pass client-ip=185.26.105.232; envelope-from=mirai@makinata.eu; helo=smtpm1.myservices.hosting X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 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 ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2022 Bruno Victal ;;; ;;; 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 + ;; /config/. + (match-record config (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 (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 (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 (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 +;;; Copyright © 2022 Bruno Victal ;;; ;;; 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))))