From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1.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 +Ns2O2RYzGazdAAA62LTzQ:P1 (envelope-from ) for ; Mon, 26 Aug 2024 10:26:45 +0000 Received: from aspmx1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1.migadu.com with LMTPS id +Ns2O2RYzGazdAAA62LTzQ (envelope-from ) for ; Mon, 26 Aug 2024 12:26:45 +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="kWGUu/eu"; dkim=fail ("headers rsa verify failed") header.d=fabionatali.com header.s=gm1 header.b=aCcd1wjo; dmarc=pass (policy=none) header.from=gnu.org; 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" ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1724668004; 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=meRC4GyhrFM5gGwm4jyT2RRHkUfKVkBaXhkPVGRM4gA=; b=hWMYFBv5oPVL+6RHSXfoRCkDA9vg4/DEK5aENqqteEfKtNs2gmp1hQCyYveu2vX4hif1ys R6lnArezWOcDC8hV1phfdMhFCbyD/9sRjKWMgO8IjoJKt9Lj86u6ktZ2TPpmtiCFj2+GmA K84lqCVBkJ7djXo5SYXq3BPU7iSpjUYUhSb52/xWE/RlaxHFKDe1h+MJU/Q94crVx66VzW cyMNx5LnSOSd+unF17qN1KTenj9RQkDr7T+/ulgGLhU+AXvBhWel+gwJkrav5anChfwU2j OF3fRlaDlTWWSWxSRYLlA3xdd4EudRsRglpjC9rpFFVov6CCi5v5dukqhl5D8g== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1724668004; a=rsa-sha256; cv=none; b=TYVqoZBQUJrCWdF1nuOZmu5GeS/VzBNDcKc0E0u0EAqd8Dt7VzgJK1Rk6r8NvSE4aoG7QC 8U69sDoz7E0VrsUonZwqlqI2Qb1AZRaKSHMIxXGdDYqCtq1xGtVbDGBIycR52Cd7eo8K4z Gff1iR3VJHqM21pQeueOoOMgZdzTapOKUZeZtNXi9Cq8hXue7m4hrvitM4x8pINlB3POBn ZzOkxlA7WW55Pbbw0DTwEyY4ERAWr1ybsEopCJWYFRlmWoFcXgM7FPnZJjx8fa0KWTNabo mAwmpRYIR7ORJ9ec8ixnRDPf6EZvRuP4f+VuXFEY7Cp3dPM81FukqYVGotcTlA== 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="kWGUu/eu"; dkim=fail ("headers rsa verify failed") header.d=fabionatali.com header.s=gm1 header.b=aCcd1wjo; dmarc=pass (policy=none) header.from=gnu.org; 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" 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 368AB672F5 for ; Mon, 26 Aug 2024 12:26:44 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1siWvQ-0008Q1-Vx; Mon, 26 Aug 2024 06:26:17 -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 1siWvO-0008Pm-50 for guix-patches@gnu.org; Mon, 26 Aug 2024 06:26:14 -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 1siWvN-00052P-Dt; Mon, 26 Aug 2024 06:26:13 -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:References:In-Reply-To:Date:From:To:Subject; bh=meRC4GyhrFM5gGwm4jyT2RRHkUfKVkBaXhkPVGRM4gA=; b=kWGUu/euL8DyGQyYoDv/I3kwWs/IXs9xQiVGU7GEnuYJY3BVe4bjZ5Rajrio0L7Nk7TfjGauLMDgsTsI8W+OjrmMAXVD4MWlRXW1GJH42V/S+ZzPdBtLMqsDyY6SPH/u+FOeVYMrYhTS4eF/1nRyflEZ/QSAtv5b6yW4Wyt7LKywaNj6SYJuzr18W1MwuIDS7cBeuCn3Yy8fLr3yXKYkjN/KxR1QLKj5m5W59PrPaR/NY2XTDQwZTkZDHW4R683Necwmmq/omnntTYzEZ7XP/cqkfLmBgmGkeUYjZNWpyKDJSTdYR2UriZYD9VZSd90wCD32rRmwvuAjmOyX28SLow==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1siWw9-0008LF-Iz; Mon, 26 Aug 2024 06:27:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72398] [PATCH v5] services: Add readymedia-service-type. Resent-From: Fabio Natali Original-Sender: "Debbugs-submit" Resent-CC: pelzflorian@pelzflorian.de, ludo@gnu.org, matt@excalamus.com, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Mon, 26 Aug 2024 10:27:01 +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: 72398@debbugs.gnu.org Cc: arunisaac@systemreboot.net, mirai@makinata.eu, Fabio Natali , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer X-Debbugs-Original-Xcc: Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer Received: via spool by 72398-submit@debbugs.gnu.org id=B72398.172466796731986 (code B ref 72398); Mon, 26 Aug 2024 10:27:01 +0000 Received: (at 72398) by debbugs.gnu.org; 26 Aug 2024 10:26:07 +0000 Received: from localhost ([127.0.0.1]:43765 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1siWvG-0008Jo-9G for submit@debbugs.gnu.org; Mon, 26 Aug 2024 06:26:07 -0400 Received: from relay3-d.mail.gandi.net ([217.70.183.195]:54317) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1siWvB-0008JD-UJ for 72398@debbugs.gnu.org; Mon, 26 Aug 2024 06:26:05 -0400 Received: by mail.gandi.net (Postfix) with ESMTPSA id AD0C560003; Mon, 26 Aug 2024 10:25:03 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fabionatali.com; s=gm1; t=1724667904; 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: in-reply-to:in-reply-to:references:references; bh=meRC4GyhrFM5gGwm4jyT2RRHkUfKVkBaXhkPVGRM4gA=; b=aCcd1wjolYIi9R6GP3JBWVOdMhUkk79XgKBH939mZwRulr8+L+VmFXkpEaoW00hznbnnT4 t0tNPPV/nDfJ7cOqJbWCzgo26GEtNXRvKmuD/HhwdVvof/NUjbcsXfToWWY7g5d1hwHzbB Rv3A+TAZ5Mpq8qliJEEksZvsxJqPFuLXUvbEgr52btjtm1d9n5CpoiTIxij3aMFHR3OCmP bjPjWX4TxWXKlEu2qSWqTQUMjOqAYfWikaopxWLZwbb6n9yQjRdYkz1YsHkEPueSZRGJT5 7f0HqHeYho4XrfmFOv7qrIiBZGJog3Kej+3HXUDBJcUeFIZ4epKkG3A+qO2SYg== Date: Mon, 26 Aug 2024 11:11:36 +0100 Message-ID: X-Mailer: git-send-email 2.45.2 In-Reply-To: <5c35d80d-610f-4521-875b-34dabdc7717f@makinata.eu> References: <5c35d80d-610f-4521-875b-34dabdc7717f@makinata.eu> 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-Flow: FLOW_IN X-Migadu-Country: US X-Migadu-Spam-Score: -2.58 X-Spam-Score: -2.58 X-Migadu-Queue-Id: 368AB672F5 X-Migadu-Scanner: mx11.migadu.com X-TUID: wBamR2G7qeVj * doc/guix.texi: Add documentation. * gnu/local.mk: Add mention of new files. * gnu/services/upnp.scm: New file. * gnu/tests/upnp.scm: New file. Change-Id: I80b02235ec36b7a1ea85fea98bdc9e08126b09a3 --- Hi Arun, Bruno, Thanks for all the help so far. Not only I think the patch is in much better shape thanks to your feedback, I've also learnt tons in the process. Here's version 5 of the ReadyMedia Service patch, which now includes tests and some micro-fixes. Bruno's latest suggestion of having media types as a list is also included. On a Guix system tests can be run with this command: --8<---------------cut here---------------start------------->8--- make check-system TESTS="readymedia-service" --8<---------------cut here---------------end--------------->8--- With regard to having a configurable user and being able to switch the POLA wrapper off, I've left things as they are. As I said, I think I prefer the slight extra security and simplicity of the current version even if that comes at a slight cost in terms of flexibility. I understand I might be a bit too opinionated here and I'm glad to discuss this further - but I was wondering if this initial version of the service might be pushed to the repo in the meanwhile? Unless there's any other issue, of course. Let me know what you think. Thanks, best wishes, Fabio. doc/guix.texi | 109 ++++++++++++++++++++++ gnu/local.mk | 2 + gnu/services/upnp.scm | 208 ++++++++++++++++++++++++++++++++++++++++++ gnu/tests/upnp.scm | 173 +++++++++++++++++++++++++++++++++++ 4 files changed, 492 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 fcaf6b3fbb..a5ecc4b21c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -129,6 +129,7 @@ Copyright @copyright{} 2024 Richard Sent@* Copyright @copyright{} 2024 Dariqq@* Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@* +Copyright @copyright{} 2024 Fabio Natali@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -41605,6 +41606,114 @@ 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 the +DLNA and UPnP-VA networking protocols. For now, it 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}. For increased security, the service +makes use of @code{least-authority-wrapper} which limits the resources +that the daemon has access to. The daemon runs as the +@code{readymedia} unprivileged user, which is a member of the +@code{readymedia} group. + +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 7b8f295566..74fd56c99b 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -752,6 +752,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 \ @@ -842,6 +843,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..9127506b55 --- /dev/null +++ b/gnu/services/upnp.scm @@ -0,0 +1,208 @@ +;;; 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 + (string-append %readymedia-default-log-directory "/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)) + (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 + #~(begin + (use-modules (gnu build activation)) + (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)) + (make-forkexec-constructor + ;; "-S" is to daemonise minidlnad. + (list #$readymedia "-f" #$minidlna-conf "-S") + #:log-file #$%readymedia-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-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)))) + (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..ec2dc4fe38 --- /dev/null +++ b/gnu/tests/upnp.scm @@ -0,0 +1,173 @@ +;;; 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-service)) + +(define %readymedia-cache-file + (string-append %readymedia-default-cache-directory "/files.db")) +(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-service-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-service") + + ;; 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 + (sleep 1) + (file-exists? #$%readymedia-cache-file)) + marionette)) + (test-assert "cache file has expected permissions" + (marionette-eval + '(begin + ;; Allow some time for the file to be created. + (sleep 1) + (eqv? (stat:perms (stat #$%readymedia-cache-file)) + #o644)) + marionette)) + (test-assert "cache file is non-empty" + (marionette-eval + '(begin + (sleep 1) + (> (stat:size (stat #$%readymedia-cache-file)) 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-file) + marionette)) + (test-assert "log file has expected permissions" + (marionette-eval + '(eqv? (stat:perms (stat #$%readymedia-log-file)) + #o640) + marionette)) + (test-assert "log file is non-empty" + (marionette-eval + '(> (stat:size (stat #$%readymedia-log-file)) 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-service-test" test)) + +(define %test-readymedia-service + (system-test + (name "readymedia-service") + (description "Test the ReadyMedia service.") + (value (run-readymedia-service-test)))) base-commit: 8059adada539c86c2ce8f1353de27b0b5741fd85 -- 2.45.2