From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id wKweHyaNDmc8zQAAqHPOHw:P1 (envelope-from ) for ; Tue, 15 Oct 2024 15:41:26 +0000 Received: from aspmx1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0.migadu.com with LMTPS id wKweHyaNDmc8zQAAqHPOHw (envelope-from ) for ; Tue, 15 Oct 2024 17:41:26 +0200 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=sfzpJ2CK; dkim=fail ("headers rsa verify failed") header.d=fabionatali.com header.s=gm1 header.b=pM6nVHvr; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1729006886; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=v98aI8dSzGxCE62C8yC5oWBJbd4jog+nxmEOhGkeL8c=; b=uzEMuSEy+HqF1xtS4V9psVsEezigXP1J9zkzwN449co7Q7r50MzpausqVo2H6GEoWTXibi o29zsYtwdkWt83Qn1p43YHPIfEUNfPy8uoAGvklHf0VKtk9cvZcudr2lKKh4Pfxi+2p80Q o/WBLSzLej0aVGrWaCvUrrsdCXh95TypI2vlME5zpOheXa6M9udPCsQs4cDTSaHV9+zAmQ 9tjx5F0zlHBL1K40mOQoBqj1pRWZqSqKb/AHyrmwcdu6ByadNb8hND89sJE/2zNPlr0rR2 cTA3RPNCqjDkMQQ7ddlAp3umMOPPWl6Mpgp5bKn8YDybxQzCF/N5yMNmAF59/A== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=sfzpJ2CK; dkim=fail ("headers rsa verify failed") header.d=fabionatali.com header.s=gm1 header.b=pM6nVHvr; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Seal: i=1; s=key1; d=yhetil.org; t=1729006886; a=rsa-sha256; cv=none; b=JyNEwJlRbEcVfZd0WxpC9+6L/GVKVn5893rwDXvv4AABE51/naK5P0LE133OHNLqX1C7RI YSwG0n7k1eH6nZN7ov1DCuFSdD8YiluwLJOU9x0zJkqvbkgKtWDJaHWavrTiXgHhjnMqAp HLdUz2CTadua2sXxzqF3/KqFawFmGtWJwkIG7FyZkZsD7tmzQ3utENof+cP1mBEta4JmZh aTyWu1161gCu6yEphlMky5vu6ArQYal0dZwFngMfpjogyPa+b70W5zLYc0cdx02b01Ppf8 i0vqBbJ/s62nyuGXf18MMuUBAJ3nnTlT3ZifzjNmRLVe8LCtmtA91rpWO+Oc9g== Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id A9A8F7E4BE for ; Tue, 15 Oct 2024 17:41:25 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1t0jfG-0004Ef-5U; Tue, 15 Oct 2024 11:40:50 -0400 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 1t0jfC-0004Aa-98 for guix-patches@gnu.org; Tue, 15 Oct 2024 11:40:46 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1t0jfB-0008GN-W3; Tue, 15 Oct 2024 11:40:46 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:From:To:In-Reply-To:References:Subject; bh=v98aI8dSzGxCE62C8yC5oWBJbd4jog+nxmEOhGkeL8c=; b=sfzpJ2CKmfgb3rqx1s2UdFGR+XHbDueODY+h+ONjHRuEpMcwvI8wXf8/X46c6+woLfN5mmpYgGGy5YN7cDyNwQxyg3xozkNgTlVKaHLf8AK+OLVWojPJmz8ggDe8FlIy7/1cLgxr5pDpR+TruffSh8wy9i0DLVDXUZ5fnkdPu5PGvaZFEKS5SPA7Bu+IlPSaLxLUAWI0SxTYYxslBV5Scpx5SYd+s5zETBfsRj3nF4loH+aoELBwkAsmVcHrDuEHFghdayGI7yCIbs37gGNiF4d5ftZg1HRNVW8eNWIlkErcj2Z8cJjw6UTb5CN729PzrXuysqrOBBdqazGlIUX/Bg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1t0jfU-00028U-73; Tue, 15 Oct 2024 11:41:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72398] [PATCH v7] services: Add readymedia-service-type. References: <4fee1c18adcfd29d40d5b557bf52db0e531c3f16.1722421592.git.me@fabionatali.com> In-Reply-To: <4fee1c18adcfd29d40d5b557bf52db0e531c3f16.1722421592.git.me@fabionatali.com> Resent-From: Fabio Natali Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Tue, 15 Oct 2024 15:41:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72398 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: arunisaac@systemreboot.net, 72398@debbugs.gnu.org Cc: ludo@gnu.org, mirai@makinata.eu, Fabio Natali , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 72398-submit@debbugs.gnu.org id=B72398.17290068177711 (code B ref 72398); Tue, 15 Oct 2024 15:41:04 +0000 Received: (at 72398) by debbugs.gnu.org; 15 Oct 2024 15:40:17 +0000 Received: from localhost ([127.0.0.1]:56503 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t0jeh-00020H-VK for submit@debbugs.gnu.org; Tue, 15 Oct 2024 11:40:17 -0400 Received: from relay8-d.mail.gandi.net ([217.70.183.201]:48837) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t0jch-0001v5-90 for 72398@debbugs.gnu.org; Tue, 15 Oct 2024 11:38:12 -0400 Received: by mail.gandi.net (Postfix) with ESMTPSA id 690291BF207; Tue, 15 Oct 2024 15:37:42 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fabionatali.com; s=gm1; t=1729006665; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding; bh=v98aI8dSzGxCE62C8yC5oWBJbd4jog+nxmEOhGkeL8c=; b=pM6nVHvrtd2hwRGsUYaaRCJ+4UC19pwLhg856guRxi8Jx1kTPMxfHY4phySW8woYvtx7l2 f7VhXNLvcbohLDLiZFAHOZlAaOIS6e51Ffp5jENTnBEjpu+iAQUKj5u8xxCJNBwNTYPd2V /62YuFQlTxK/w0PNLn9w8ZKm9x99cbSgETB/LiURlwGjB1UwknFP993nVOE95v2SyDGgkk vo81CaxwjbLCjuAkA0DLNEJ79nBRRqilFjvdBzmQlr+ZrmcUjoQOY0bIuzJAYXW1h/BMRP QHbToElGBnsXIEzffZxASouufePCqFTCtY/9b4kLC6l6qIxJLuUWY16sCk6WEQ== Date: Tue, 15 Oct 2024 16:31:40 +0100 Message-ID: <5259d0a6ad45dd789f677bd2daf1dc05c0424738.1729005784.git.me@fabionatali.com> X-Mailer: git-send-email 2.46.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-GND-Sasl: me@fabionatali.com 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: , Reply-to: Fabio Natali X-ACL-Warn: , Fabio Natali via Guix-patches From: Fabio Natali via Guix-patches via Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-Migadu-Scanner: mx11.migadu.com X-Migadu-Spam-Score: 1.48 X-Spam-Score: 1.48 X-Migadu-Queue-Id: A9A8F7E4BE X-TUID: FflBi0tgy/Ib * doc/guix.texi (Miscellaneous Services): New node. * gnu/local.mk: Add mention of new files. * gnu/services/upnp.scm: New file. * gnu/tests/upnp.scm: New file. Change-Id: I6a3c9db9e7504df308038343ed48e4409a323581 --- Hey Arun, Thanks for looking into this. Are you sure you used v6 of the patch? When I tried v6 on top of a recent checkout today, that didn't apply straightaway because of some conflicts. I then rebased it and created the attached v7. v7 works fine on my system and tests can be successfully run with the command you used: 'make check-system TESTS="readymedia"'. Could you please try v7 on a recent checkout and see if the above works? I feel we're getting closer! Thanks for all the help. Best, F. doc/guix.texi | 105 +++++++++++++++++++++ gnu/local.mk | 2 + gnu/services/upnp.scm | 213 ++++++++++++++++++++++++++++++++++++++++++ gnu/tests/upnp.scm | 178 +++++++++++++++++++++++++++++++++++ 4 files changed, 498 insertions(+) create mode 100644 gnu/services/upnp.scm create mode 100644 gnu/tests/upnp.scm diff --git a/doc/guix.texi b/doc/guix.texi index 29bce718d4..2c5754c6c5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -41773,6 +41773,111 @@ Miscellaneous Services @end deftp +@c %end of fragment + +@cindex DLNA/UPnP +@subsubheading DLNA/UPnP Services + +The @code{(gnu services upnp)} module offers services related to UPnP +(Universal Plug and Play) and DLNA (Digital Living Network Alliance), +networking protocols that can be used for media streaming and device +interoperability within a local network. For now, this module +provides the @code{readymedia-service-type}. + +@uref{https://sourceforge.net/projects/minidlna/, ReadyMedia} +(formerly known as MiniDLNA) is a DLNA/UPnP-AV media server. The +project's daemon, @code{minidlnad}, can serve media files (audio, +pictures, and video) to DLNA/UPnP-AV clients available in the network. +@code{readymedia-service-type} is a Guix service that wraps around +ReadyMedia's @code{minidlnad}. + +Consider the following configuration: + +@lisp +(use-service-modules upnp @dots{}) + +(operating-system + ;; @dots{} + (services + (list + (service readymedia-service-type + (readymedia-configuration + (media-directoriess + (list + (readymedia-media-directory (path "/media/audio") + (types '(A))) + (readymedia-media-directory (path "/media/video") + (types '(V))) + (readymedia-media-directory (path "/media/misc")))) + (extra-config '(("notify_interval" . 60))))) + ;; @dots{} + ))) +@end lisp + +This sets up the ReadyMedia daemon to serve files from the media +folders specified in @code{media-directories}. The +@code{media-directories} field is mandatory. All other fields (such +as network ports and the server name) come with a predefined default +and can be omitted. + +@c %start of fragment + +@deftp {Data Type} readymedia-configuration +Available @code{readymedia-configuration} fields are: + +@table @asis +@item @code{readymedia} (default: @code{readymedia}) (type: package) +The ReadyMedia package to be used for the service. + +@item @code{friendly-name} (default: @code{#f}) (type: maybe-string) +A custom name that will be displayed on connected clients. + +@item @code{media-directories} (type: list) +The list of media folders to serve content from. Each item is a +@code{readymedia-media-directory}. + +@item @code{cache-directory} (default: @code{"/var/cache/readymedia"}) (type: string) +A folder for ReadyMedia's cache files. If not existing already, the +folder will be created as part of the service activation and the +ReadyMedia user will be assigned ownership. + +@item @code{log-directory} (default: @code{"/var/log/readymedia"}) (type: string) +A folder for ReadyMedia's log files. If not existing already, the +folder will be created as part of the service activation and the +ReadyMedia user will be assigned ownership. + +@item @code{port} (default: @code{#f}) (type: maybe-integer) +A custom port that the service will be listening on. + +@item @code{extra-config} (default: @code{'()}) (type: alist) +An association list of further options, as accepted by ReadyMedia. + +@end table + +@end deftp + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} readymedia-media-directory +A @code{media-directories} entry includes a folder @code{path} and, +optionally, the @code{types} of media files included within the +folder. + +@table @asis +@item @code{path} (type: string) +The media folder location. + +@item @code{types} (default: @code{'()}) (type: list) +A list indicating the types of file included in the media folder. +Valid values are combinations of individual media types, i.e. symbol +@code{A} for audio, @code{P} for pictures, @code{V} for video. An +empty list means no type specified. + +@end table + +@end deftp @c %end of fragment diff --git a/gnu/local.mk b/gnu/local.mk index 5d1b316aa3..02aec3ac67 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -756,6 +756,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/syncthing.scm \ %D%/services/sysctl.scm \ %D%/services/telephony.scm \ + %D%/services/upnp.scm \ %D%/services/version-control.scm \ %D%/services/vnc.scm \ %D%/services/vpn.scm \ @@ -846,6 +847,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/singularity.scm \ %D%/tests/ssh.scm \ %D%/tests/telephony.scm \ + %D%/tests/upnp.scm \ %D%/tests/version-control.scm \ %D%/tests/virtualization.scm \ %D%/tests/vnc.scm \ diff --git a/gnu/services/upnp.scm b/gnu/services/upnp.scm new file mode 100644 index 0000000000..ad13f97827 --- /dev/null +++ b/gnu/services/upnp.scm @@ -0,0 +1,213 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Fabio Natali +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services upnp) + #:use-module (gnu build linux-container) + #:use-module (gnu packages admin) + #:use-module (gnu packages upnp) + #:use-module (gnu services admin) + #:use-module (gnu services base) + #:use-module (gnu services shepherd) + #:use-module (gnu services) + #:use-module (gnu system file-systems) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix least-authority) + #:use-module (guix records) + #:use-module (ice-9 match) + #:export (%readymedia-default-cache-directory + %readymedia-default-log-directory + %readymedia-default-port + %readymedia-log-file + %readymedia-user-account + %readymedia-user-group + readymedia-configuration + readymedia-configuration-cache-directory + readymedia-configuration-extra-config + readymedia-configuration-friendly-name + readymedia-configuration-log-directory + readymedia-configuration-media-directories + readymedia-configuration-port + readymedia-configuration-readymedia + readymedia-configuration? + readymedia-media-directory + readymedia-media-directory-path + readymedia-media-directory-types + readymedia-media-directory? + readymedia-service-type)) + +;;; Commentary: +;;; +;;; UPnP services. +;;; +;;; Code: + +(define %readymedia-default-cache-directory "/var/cache/readymedia") +(define %readymedia-default-log-directory "/var/log/readymedia") +(define %readymedia-log-file "minidlna.log") +(define %readymedia-user-group "readymedia") +(define %readymedia-user-account "readymedia") + +(define-record-type* + readymedia-configuration make-readymedia-configuration + readymedia-configuration? + (readymedia readymedia-configuration-readymedia + (default readymedia)) + (cache-directory readymedia-configuration-cache-directory + (default %readymedia-default-cache-directory)) + (log-directory readymedia-configuration-log-directory + (default %readymedia-default-log-directory)) + (friendly-name readymedia-configuration-friendly-name + (default #f)) + (media-directories readymedia-configuration-media-directories) + (port readymedia-configuration-port + (default #f)) + (extra-config readymedia-configuration-extra-config + (default '()))) + +;; READYMEDIA-MEDIA-DIR is a record that indicates the path of a media folder +;; and the types of media included within it. Allowed individual types are the +;; symbols 'A' for audio, 'V' for video, and 'P' for pictures. The types field +;; can contain any combination of individual types; an empty list means no type +;; specified. +(define-record-type* + readymedia-media-directory make-readymedia-media-directory + readymedia-media-directory? + (path readymedia-media-directory-path) + (types readymedia-media-directory-types (default '()))) + +(define (readymedia-media-directory->string entry) + "Convert a media-directory ENTRY to a ReadyMedia/MiniDLNA media dir string." + (match-record + entry (path types) + (if (null? types) + (format #f "media_dir=~a" path) + (format #f + "media_dir=~a,~a" + (string-join (map symbol->string types) "") + path)))) + +(define (readymedia-extra-config-entry->string entry) + "Convert a extra-config ENTRY to a ReadyMedia/MiniDLNA configuration string." + (let ((key (car entry)) + (value (cdr entry))) + (format #f "~a=~a" key value))) + +(define (readymedia-configuration->config-file config) + "Return the ReadyMedia/MiniDLNA configuration file corresponding to CONFIG." + (let ((friendly-name (readymedia-configuration-friendly-name config)) + (media-directories (readymedia-configuration-media-directories config)) + (cache-directory (readymedia-configuration-cache-directory config)) + (log-directory (readymedia-configuration-log-directory config)) + (port (readymedia-configuration-port config)) + (extra-config (readymedia-configuration-extra-config config))) + (mixed-text-file + "minidlna.conf" + "db_dir=" cache-directory "\n" + "log_dir=" log-directory "\n" + (if friendly-name (format #f "friendly_name=~a\n" friendly-name) "") + (if port (format #f "port=~a\n" port) "") + (string-join + (map readymedia-media-directory->string media-directories) "\n" 'suffix) + (string-join + (map readymedia-extra-config-entry->string extra-config) "\n" 'suffix)))) + +(define (readymedia-shepherd-service config) + "Return a least-authority ReadyMedia/MiniDLNA Shepherd service." + (let* ((minidlna-conf (readymedia-configuration->config-file config)) + (media-directories (readymedia-configuration-media-directories config)) + (cache-directory (readymedia-configuration-cache-directory config)) + (log-directory (readymedia-configuration-log-directory config)) + (log-file (string-append log-directory "/" %readymedia-log-file)) + (readymedia (least-authority-wrapper + (file-append + (readymedia-configuration-readymedia config) + "/sbin/minidlnad") + #:name "minidlna" + #:mappings + (cons* (file-system-mapping + (source cache-directory) + (target source) + (writable? #t)) + (file-system-mapping + (source log-directory) + (target source) + (writable? #t)) + (file-system-mapping + (source minidlna-conf) + (target source)) + (map + (lambda (e) + (file-system-mapping + (source (readymedia-media-directory-path e)) + (target source) + (writable? #f))) + media-directories)) + #:namespaces (delq 'net %namespaces)))) + (list (shepherd-service + (documentation "Run the ReadyMedia/MiniDLNA daemon.") + (provision '(readymedia)) + (requirement '(networking user-processes)) + (start + #~(make-forkexec-constructor + ;; "-S" is to daemonise minidlnad. + (list #$readymedia "-f" #$minidlna-conf "-S") + #:log-file #$log-file + #:user #$%readymedia-user-account + #:group #$%readymedia-user-group)) + (stop #~(make-kill-destructor)))))) + +(define readymedia-accounts + (list (user-group + (name "readymedia") + (system? #t)) + (user-account + (name "readymedia") + (group "readymedia") + (system? #t) + (comment "ReadyMedia/MiniDLNA daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define (readymedia-activation config) + "Set up directories for ReadyMedia/MiniDLNA." + (let ((cache-directory (readymedia-configuration-cache-directory config)) + (log-directory (readymedia-configuration-log-directory config)) + (media-directories (readymedia-configuration-media-directories config))) + #~(begin + (use-modules (guix build utils)) + (let* ((user (getpw #$%readymedia-user-account)) + (dirs (list #$cache-directory + #$log-directory + #$@(map (lambda (e) + (readymedia-media-directory-path e)) + media-directories))) + (init-directory (lambda (d) (unless (file-exists? d) + (mkdir-p/perms d user #o755))))) + (for-each init-directory dirs))))) + +(define readymedia-service-type + (service-type + (name 'readymedia) + (extensions + (list + (service-extension shepherd-root-service-type readymedia-shepherd-service) + (service-extension account-service-type (const readymedia-accounts)) + (service-extension activation-service-type readymedia-activation))) + (description + "Run @command{minidlnad}, the ReadyMedia/MiniDLNA media server."))) diff --git a/gnu/tests/upnp.scm b/gnu/tests/upnp.scm new file mode 100644 index 0000000000..8e92594901 --- /dev/null +++ b/gnu/tests/upnp.scm @@ -0,0 +1,178 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Fabio Natali +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu tests upnp) + #:use-module (gnu services) + #:use-module (gnu services networking) + #:use-module (gnu services upnp) + #:use-module (gnu system vm) + #:use-module (gnu tests) + #:use-module (guix gexp) + #:export (%test-readymedia)) + +(define %readymedia-cache-file "files.db") +(define %readymedia-cache-path + (string-append %readymedia-default-cache-directory + "/" + %readymedia-cache-file)) +(define %readymedia-log-path + (string-append %readymedia-default-log-directory + "/" + %readymedia-log-file)) +(define %readymedia-default-port 8200) +(define %readymedia-media-directory "/media") +(define %readymedia-configuration-test + (readymedia-configuration + (media-directories + (list + (readymedia-media-directory (path %readymedia-media-directory) + (types '(A V))))))) + +(define (run-readymedia-test) + (define os + (marionette-operating-system + (simple-operating-system + (service dhcp-client-service-type) + (service readymedia-service-type + %readymedia-configuration-test)) + #:imported-modules '((gnu services herd) + (json parser)) + #:requirements '(readymedia))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette + (list #$(virtual-machine + (operating-system os) + (port-forwardings '()))))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "readymedia") + + ;; ReadyMedia user. + (test-assert "ReadyMedia user exists" + (marionette-eval + '(begin + (getpwnam #$%readymedia-user-account) + #t) + marionette)) + (test-assert "ReadyMedia group exists" + (marionette-eval + '(begin + (getgrnam #$%readymedia-user-group) + #t) + marionette)) + + ;; Cache directory and file. + (test-assert "cache directory exists" + (marionette-eval + '(eq? (stat:type (stat #$%readymedia-default-cache-directory)) + 'directory) + marionette)) + (test-assert "cache directory has correct ownership" + (marionette-eval + '(let ((cache-dir (stat #$%readymedia-default-cache-directory)) + (user (getpwnam #$%readymedia-user-account))) + (and (eqv? (stat:uid cache-dir) (passwd:uid user)) + (eqv? (stat:gid cache-dir) (passwd:gid user)))) + marionette)) + (test-assert "cache directory has expected permissions" + (marionette-eval + '(eqv? (stat:perms (stat #$%readymedia-default-cache-directory)) + #o755) + marionette)) + (test-assert "cache file exists" + (marionette-eval + '(begin + ;; Allow some time for the file to be created. + (sleep 2) + (file-exists? #$%readymedia-cache-path)) + marionette)) + (test-assert "cache file has expected permissions" + (marionette-eval + '(begin + (eqv? (stat:perms (stat #$%readymedia-cache-path)) + #o644)) + marionette)) + (test-assert "cache file is non-empty" + (marionette-eval + '(begin + (> (stat:size (stat #$%readymedia-cache-path)) 0)) + marionette)) + + ;; Log directory and file. + (test-assert "log directory exists" + (marionette-eval + '(eq? (stat:type (stat #$%readymedia-default-log-directory)) + 'directory) + marionette)) + (test-assert "log directory has correct ownership" + (marionette-eval + '(let ((log-dir (stat #$%readymedia-default-log-directory)) + (user (getpwnam #$%readymedia-user-account))) + (and (eqv? (stat:uid log-dir) (passwd:uid user)) + (eqv? (stat:gid log-dir) (passwd:gid user)))) + marionette)) + (test-assert "log directory has expected permissions" + (marionette-eval + '(eqv? (stat:perms (stat #$%readymedia-default-log-directory)) + #o755) + marionette)) + (test-assert "log file exists" + (marionette-eval + '(file-exists? #$%readymedia-log-path) + marionette)) + (test-assert "log file has expected permissions" + (marionette-eval + '(eqv? (stat:perms (stat #$%readymedia-log-path)) + #o640) + marionette)) + (test-assert "log file is non-empty" + (marionette-eval + '(> (stat:size (stat #$%readymedia-log-path)) 0) + marionette)) + + ;; Service. + (test-assert "ReadyMedia service is running" + (marionette-eval + '(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + (live-service-running + (find (lambda (live-service) + (memq 'readymedia + (live-service-provision live-service))) + (current-services)))) + marionette)) + (test-assert "ReadyMedia service is listening for connections" + (wait-for-tcp-port #$%readymedia-default-port marionette)) + + (test-end)))) + + (gexp->derivation "readymedia-test" test)) + +(define %test-readymedia + (system-test + (name "readymedia") + (description "Test the ReadyMedia service.") + (value (run-readymedia-test)))) base-commit: f443f5b0cd77cbbfa70cd915b4082ce32340127e -- 2.46.0