[bug#72398,v6] services: Add readymedia-service-type.
Commit Message
* 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: I80b02235ec36b7a1ea85fea98bdc9e08126b09a3
---
Hi Ludo,
Thanks for reviewing this and providing feedback! I think I've addressed
all points. I'm adding my comments inline below plus the updated patch
at the end.
Thanks, cheers, Fabio. 🙏
> This is really minor, but please mention the place where this is
> added, like:
>
> * doc/guix.texi (Section Name): New node.
Fixed.
> > +The @code{(gnu services upnp)} module offers services related to
> > the +DLNA and UPnP-VA networking protocols. For now, it provides
> > the
>
> I would add a few words about what DLNA and UPnP-VA allow users to do,
> and perhaps what they mean.
Fixed.
> > +@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.
>
> I would omit everything that follows “For increased security” since
> it’s largely an implementation detail (a nice one though!) and could
> get out of sync over time.
Fixed.
> But! While I agree in principle with what Bruno wrote about the
> shortcomings of activation snippets, I would stick to an activation
> snippet here to create directories etc. The change Bruno proposes
> should be treated separately and systematically across all the
> services, not just one of them.
Fixed - reverted to using an activation snippet.
> > +(define %test-readymedia-service
>
> Just ‘%test-readymedia’…
Fixed.
> > + (system-test
> > + (name "readymedia-service")
>
> … and “readymedia”, for consistency with other tests.
Fixed.
Tests can be run with:
--8<---------------cut here---------------start------------->8---
make check-system TESTS="readymedia"
--8<---------------cut here---------------end--------------->8---
I get a green light on my machine. I had to add a slight delay to one of
the tests to give enough time for a file to be created. Not super happy
about it as the test could theoretically fail on a slow machine - but
hopefully it's alright.
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
base-commit: 123b7226a0442ee4103c04064d453421424d5fac
Comments
On 2024-09-08, 21:04 +0100, Fabio Natali <me@fabionatali.com> wrote:
> I'm adding my comments inline below plus the updated patch at the end.
Hi All,
I thought of bumping this up, in case anyone had the time for a final
check and, if all looks good, to push it to Guix.
Have a lovely evening, cheers, Fabio.
Hi Fabio,
Sorry for the long wait. I'll push it tomorrow.
Thanks!
Arun
Hi Fabio,
Some tests fail on my machine. Could you figure out what went wrong?
--8<---------------cut here---------------start------------->8---
$ make check-system TESTS="readymedia"
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Selected 0 system tests...
guix build: warning: no arguments specified, nothing to do
--8<---------------cut here---------------end--------------->8---
Then, I tried with TESTS="readymedia-service". Maybe the test needs to
be renamed?
--8<---------------cut here---------------start------------->8---
$ make check-system TESTS="readymedia-service"
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Selected 1 system tests...
substitute: updating substitutes from 'https://ci.guix.gnu.org'... 100.0%
The following derivation will be built:
/gnu/store/7fpmgpyd4kcff23bhnw4wk3dakka0wrv-readymedia-service-test.drv
building /gnu/store/7fpmgpyd4kcff23bhnw4wk3dakka0wrv-readymedia-service-test.drv...
%1bcSeaBIOS (version 1.16.2/GNU Guix)
iPXE (https://ipxe.org) 00:03.0 CA00 PCI2.10 PnP PMM+0EFCAE60+0EF0AE60 CA00
Booting from ROM...
%1bcGC Warning: pthread_getattr_np or pthread_attr_getstack failed for main thread
GC Warning: Could not open /proc/stat
Welcome, this is GNU's early boot Guile.
Use 'gnu.repl' for an initrd REPL.
loading kernel modules...
loading '/gnu/store/5albnzzllh18x8mgvah2f8dcx2jks94l-system/boot'...
making '/gnu/store/5albnzzllh18x8mgvah2f8dcx2jks94l-system' the current system...
setting up privileged programs in '/run/privileged/bin'...
populating /etc from /gnu/store/f5i5fi5x4mvh0czmhzns8x5raa1w5hcy-etc...
Please wait while gathering entropy to generate the key pair;
this may take time...
[ 40.882996] udevd[88]: specified group 'sgx' unknown
[ 41.926472] udevd[88]: no sender credentials received, message ignored
[ 50.662818] Error: Driver 'pcspkr' is already registered, aborting...
This is the GNU system. Welcome.
komputilo login: ice-9/eval.scm:159:9: In procedure stat: No such file or directory: "/var/cache/readymedia/files.db"
ice-9/eval.scm:159:9: In procedure stat: No such file or directory: "/var/cache/readymedia/files.db"
Tests failed, dumping log file '/gnu/store/kslqxyv87irslkmfdk7giaglz9hrqzby-readymedia-service-test/readymedia-service.log'.
%%%% Starting test readymedia-service
Group begin: readymedia-service
Test begin:
test-name: "ReadyMedia user exists"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "ReadyMedia user exists" (marionette-eval (quote (begin (getpwnam "readymedia") #t)) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "ReadyMedia group exists"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "ReadyMedia group exists" (marionette-eval (quote (begin (getgrnam "readymedia") #t)) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "cache directory exists"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "cache directory exists" (marionette-eval (quote (eq? (stat:type (stat "/var/cache/readymedia")) (quote directory))) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "cache directory has correct ownership"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "cache directory has correct ownership" (marionette-eval (quote (let ((cache-dir (stat "/var/cache/readymedia")) (user (getpwnam "readymedia"))) (and (eqv? (stat:uid cache-dir) (passwd:uid user)) (eqv? (stat:gid cache-dir) (passwd:gid user))))) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "cache directory has expected permissions"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "cache directory has expected permissions" (marionette-eval (quote (eqv? (stat:perms (stat "/var/cache/readymedia")) 493)) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "cache file exists"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "cache file exists" (marionette-eval (quote (begin (sleep 1) (file-exists? "/var/cache/readymedia/files.db"))) marionette))
Test end:
result-kind: fail
actual-value: #f
Test begin:
test-name: "cache file has expected permissions"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "cache file has expected permissions" (marionette-eval (quote (begin (sleep 1) (eqv? (stat:perms (stat "/var/cache/readymedia/files.db")) 420))) marionette))
Test end:
result-kind: fail
actual-value: #f
Test begin:
test-name: "cache file is non-empty"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "cache file is non-empty" (marionette-eval (quote (begin (sleep 1) (> (stat:size (stat "/var/cache/readymedia/files.db")) 0))) marionette))
Test end:
result-kind: fail
actual-value: #f
Test begin:
test-name: "log directory exists"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "log directory exists" (marionette-eval (quote (eq? (stat:type (stat "/var/log/readymedia")) (quote directory))) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "log directory has correct ownership"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "log directory has correct ownership" (marionette-eval (quote (let ((log-dir (stat "/var/log/readymedia")) (user (getpwnam "readymedia"))) (and (eqv? (stat:uid log-dir) (passwd:uid user)) (eqv? (stat:gid log-dir) (passwd:gid user))))) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "log directory has expected permissions"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "log directory has expected permissions" (marionette-eval (quote (eqv? (stat:perms (stat "/var/log/readymedia")) 493)) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "log file exists"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "log file exists" (marionette-eval (quote (file-exists? "/var/log/readymedia/minidlna.log")) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "log file has expected permissions"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "log file has expected permissions" (marionette-eval (quote (eqv? (stat:perms (stat "/var/log/readymedia/minidlna.log")) 416)) marionette))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "log file is non-empty"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "log file is non-empty" (marionette-eval (quote (> (stat:size (stat "/var/log/readymedia/minidlna.log")) 0)) marionette))
Test end:
result-kind: fail
actual-value: #f
Test begin:
test-name: "ReadyMedia service is running"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "ReadyMedia service is running" (marionette-eval (quote (begin (use-modules (gnu services herd) (srfi srfi-1)) (live-service-running (find (lambda (live-service) (memq (quote readymedia) (live-service-provision live-service))) (current-services))))) marionette))
Test end:
result-kind: pass
actual-value: 144
Test begin:
test-name: "ReadyMedia service is listening for connections"
source-file: "/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder"
source-line: 1
source-form: (test-assert "ReadyMedia service is listening for connections" (wait-for-tcp-port 8200 marionette))
Test end:
result-kind: pass
actual-value: #t
Group end: readymedia-service
# of expected passes 12
# of unexpected failures 4
QEMU runs as PID 4
connected to QEMU's monitor
read QEMU monitor prompt
connected to guest REPL
%%%% Starting test readymedia-service (Writing full log to "/gnu/store/kslqxyv87irslkmfdk7giaglz9hrqzby-readymedia-service-test/readymedia-service.log")
marionette is ready
PASS: ReadyMedia user exists
PASS: ReadyMedia group exists
PASS: cache directory exists
PASS: cache directory has correct ownership
PASS: cache directory has expected permissions
/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder:1: FAIL cache file exists
/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder:1: FAIL cache file has expected permissions
/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder:1: FAIL cache file is non-empty
PASS: log directory exists
PASS: log directory has correct ownership
PASS: log directory has expected permissions
PASS: log file exists
PASS: log file has expected permissions
/gnu/store/gsx8qj064jqqjc9bm1csiqh2r5m0wfqf-readymedia-service-test-builder:1: FAIL log file is non-empty
PASS: ReadyMedia service is running
PASS: ReadyMedia service is listening for connections
# of expected passes 12
# of unexpected failures 4
note: keeping build directory `/tmp/guix-build-readymedia-service-test.drv-2'
builder for `/gnu/store/7fpmgpyd4kcff23bhnw4wk3dakka0wrv-readymedia-service-test.drv' failed with exit code 1
build of /gnu/store/7fpmgpyd4kcff23bhnw4wk3dakka0wrv-readymedia-service-test.drv failed
View build log at '/var/log/guix/drvs/7f/pmgpyd4kcff23bhnw4wk3dakka0wrv-readymedia-service-test.drv.gz'.
guix build: error: build of `/gnu/store/7fpmgpyd4kcff23bhnw4wk3dakka0wrv-readymedia-service-test.drv' failed
make: *** [Makefile:7356: check-system] Error 1
--8<---------------cut here---------------end--------------->8---
Thanks!
Arun
On 2024-10-14, 22:57 +0100, Arun Isaac <arunisaac@systemreboot.net> wrote:
> Some tests fail on my machine. Could you figure out what went wrong?
I've replied separately with a v7. Annoyingly (arrrgh!) I mistyped
'--in-reply-to=' in a separate line and broke the email thread as a
result. Apologies.
@@ -41635,6 +41635,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
@@ -754,6 +754,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 \
@@ -844,6 +845,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 \
new file mode 100644
@@ -0,0 +1,213 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Fabio Natali <me@fabionatali.com>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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>
+ 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>
+ 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 <readymedia-media-directory> (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.")))
new file mode 100644
@@ -0,0 +1,178 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Fabio Natali <me@fabionatali.com>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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))))