mirror/guix
mirror/guix
1
Fork 0
mirror of https://https.git.savannah.gnu.org/git/guix.git/ synced 2025-07-15 19:40:46 +02:00
Code Releases Activity

gnu: services: Add readymedia service.

Browse source 
* gnu/services/upnp.scm, gnu/tests/upnp.scm: New files.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add them.
* doc/guix.texi (Miscellaneous Services): Document the service.

Change-Id: I6a3c9db9e7504df308038343ed48e4409a323581
Signed-off-by: Arun Isaac <arunisaac@systemreboot.net>
This commit is contained in:
Fabio Natali 2024-10-15 16:31:40 +01:00 • committed by Arun Isaac
parent 061e0acd59
commit 8c6d24d388
No known key found for this signature in database
GPG key ID: 2E25EE8B61802BB3
4 changed files with 465 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

101
doc/guix.texi
View file

@ -41774,6 +41774,107 @@ invokation.
@end deftp @end deftp
@c %end of fragment
@cindex DLNA/UPnP
@subsubheading DLNA/UPnP Services
The @code{(gnu services upnp)} module offers services related to
@acronym{UPnP, Universal Plug and Play} and @acronym{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 on 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 that no type is specified.
@end table
@end deftp
@c %end of fragment @c %end of fragment

2
gnu/local.mk
View file

@ -756,6 +756,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/syncthing.scm \ %D%/services/syncthing.scm \
%D%/services/sysctl.scm \ %D%/services/sysctl.scm \
%D%/services/telephony.scm \ %D%/services/telephony.scm \
%D%/services/upnp.scm \
%D%/services/version-control.scm \ %D%/services/version-control.scm \
%D%/services/vnc.scm \ %D%/services/vnc.scm \
%D%/services/vpn.scm \ %D%/services/vpn.scm \
@ -846,6 +847,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/singularity.scm \ %D%/tests/singularity.scm \
%D%/tests/ssh.scm \ %D%/tests/ssh.scm \
%D%/tests/telephony.scm \ %D%/tests/telephony.scm \
%D%/tests/upnp.scm \
%D%/tests/version-control.scm \ %D%/tests/version-control.scm \
%D%/tests/virtualization.scm \ %D%/tests/virtualization.scm \
%D%/tests/vnc.scm \ %D%/tests/vnc.scm \

207
gnu/services/upnp.scm Normal file
View file

@ -0,0 +1,207 @@
;;; 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 modules)
#: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?
readymedia-configuration-readymedia
readymedia-configuration-port
readymedia-configuration-cache-directory
readymedia-configuration-extra-config
readymedia-configuration-friendly-name
readymedia-configuration-log-directory
readymedia-configuration-media-directories
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))
(port readymedia-configuration-port
(default #f))
(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)
(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 that
;; no type is 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-configuration->config-file config)
"Return the ReadyMedia/MiniDLNA configuration file corresponding to CONFIG."
(match-record config <readymedia-configuration>
(port friendly-name cache-directory log-directory media-directories extra-config)
(apply mixed-text-file
"minidlna.conf"
"db_dir=" cache-directory "\n"
"log_dir=" log-directory "\n"
(if friendly-name
(string-append "friendly_name=" friendly-name "\n")
"")
(if port
(string-append "port=" (number->string port) "\n")
"")
(append (map (match-record-lambda <readymedia-media-directory>
(path types)
(apply string-append
"media_dir="
(append (map symbol->string types)
(match types
(() (list))
(_ (list ",")))
(list path))))
media-directories)
(map (match-lambda
((key . value)
(string-append key "=" value "\n")))
extra-config)))))
(define (readymedia-shepherd-service config)
"Return a least-authority ReadyMedia/MiniDLNA Shepherd service."
(match-record config <readymedia-configuration>
(cache-directory log-directory media-directories)
(let ((minidlna-conf (readymedia-configuration->config-file config)))
(shepherd-service
(documentation "Run the ReadyMedia/MiniDLNA daemon.")
(provision '(readymedia))
(requirement '(networking user-processes))
(start
#~(make-forkexec-constructor
(list #$(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 (directory)
(file-system-mapping
(source (readymedia-media-directory-path directory))
(target source)))
media-directories))
#:namespaces (delq 'net %namespaces))
"-f"
#$minidlna-conf
"-S")
#:log-file #$(string-append log-directory "/" %readymedia-log-file)
#:user #$%readymedia-user-account
#:group #$%readymedia-user-group))
(stop #~(make-kill-destructor))))))
(define readymedia-accounts
(list (user-account
(name "readymedia")
(group "readymedia")
(system? #t)
(comment "ReadyMedia/MiniDLNA daemon user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))
(user-group
(name "readymedia")
(system? #t))))
(define (readymedia-activation config)
"Set up directories for ReadyMedia/MiniDLNA."
(match-record config <readymedia-configuration>
(cache-directory log-directory media-directories)
(with-imported-modules (source-module-closure '((gnu build activation)))
#~(begin
(use-modules (gnu build activation))
(for-each (lambda (directory)
(unless (file-exists? directory)
(mkdir-p/perms directory
(getpw #$%readymedia-user-account)
#o755)))
(list #$cache-directory
#$log-directory
#$@(map readymedia-media-directory-path
media-directories)))))))
(define readymedia-service-type
(service-type
(name 'readymedia)
(extensions
(list (service-extension shepherd-root-service-type
(compose list 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.")))

155
gnu/tests/upnp.scm Normal file
View file

@ -0,0 +1,155 @@
;;; 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))
;; 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))
;; 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))))