[bug#72398] [PATCH] services: Add readymedia-service-type.

[Fabio Natali]

* gnu/services/upnp.scm: New file.
* gnu/local.mk: Add this.
* doc/guix.texi: Document this.

Change-Id: I87c17d3afeaf94b5294b4add5649701b087b6897
---
Hi! 👋

This is to add 'readymedia-service-type'.

ReadyMedia⁰ (formerly known as MiniDLNA) is a DLNA/UPnP-AV media server. The
project’s daemon, 'minidlnad', can serve media files (audio, pictures, and
video) to DLNA/UPnP-AV clients available in the network.

'readymedia-service-type' is a Guix service that wraps around ReadyMedia’s
'minidlnad'. For increased security, the service makes use of
'least-authority-wrapper' which limits the resources that the daemon has access
to. The daemon runs as the readymedia unprivileged user, which is a member of
the readymedia group.

The 'readymedia-configuration' record gives the opportunity to configure various
aspects, such as the media folders to serve content from, the service name, the
service port, etc. An 'extra-config' field acts as a wildcard for all other
ReadyMedia options that are not mapped into the record.

I'm not very happy about the way some of the configuration options are hardcoded
(e.g. the user, the cache and log folders). I thought this is "good enough" for
now, but I'm looking forward to your comments.

This is my first Guix service (yay!) so feedback is particularly welcome.

Have a lovely day. Cheers, Fabio.

⁰ https://sourceforge.net/projects/minidlna/

PS: Guix's 'minidlnad' has a small bug at the moment. This patch requires this
other fix to work properly:
https://lists.gnu.org/archive/html/guix-patches/2024-07/msg01239.html


 doc/guix.texi         |  93 +++++++++++++++++++++++
 gnu/local.mk          |   1 +
 gnu/services/upnp.scm | 170 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 264 insertions(+)
 create mode 100644 gnu/services/upnp.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 41814042f5..026246eeda 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
@@ -41594,6 +41595,98 @@ 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-dirs
+               (list (readymedia-media-dir (path "/media/audio")
+                                           (type "A"))
+                     (readymedia-media-dir (path "/media/video")
+                                           (type "V"))
+                     (readymedia-media-dir (path "/media/misc"))))))
+@end lisp
+
+This sets up the ReadyMedia daemon to serve files from the media
+folders specified in @code{media-dirs}.  The @code{media-dirs} 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-dirs} (type: list)
+The list of media folders to serve content from.  Each item is a
+@code{readymedia-media-dir}.
+
+@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: list-of-strings)
+A list of further options, to be passed as key-value strings as
+accepted by ReadyMedia.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} readymedia-media-dir
+A @code{media-dirs} entry includes a @code{path} and, optionally, a
+media type string.
+
+@table @asis
+@item @code{path} (type: string)
+The media folder location.
+
+@item @code{type} (default: @code{""}) (type: string)
+Valid media types are @code{"A"} for audio, @code{"P"} for pictures,
+@code{"V"} for video, and a combination of those individual letters
+for mixed types.  An empty string means no type specified.
+
+@end table
+
+@end deftp
 
 @c %end of fragment
 
diff --git a/gnu/local.mk b/gnu/local.mk
index fac7b5973b..2da8ec3be3 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -749,6 +749,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                         \
diff --git a/gnu/services/upnp.scm b/gnu/services/upnp.scm
new file mode 100644
index 0000000000..49f176861e
--- /dev/null
+++ b/gnu/services/upnp.scm
@@ -0,0 +1,170 @@
+;;; 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)
+  #:export (readymedia-configuration
+            readymedia-configuration-readymedia
+            readymedia-configuration-friendly-name
+            readymedia-configuration-media-dirs
+            readymedia-configuration-port
+            readymedia-configuration-extra-config
+            readymedia-configuration?
+            readymedia-media-dir
+            readymedia-media-dir-path
+            readymedia-media-dir-type
+            readymedia-media-dir?
+            readymedia-service-type))
+
+;;; Commentary:
+;;;
+;;; UPnP services.
+;;;
+;;; Code:
+
+(define %readymedia-cache-dir "/var/cache/readymedia")
+(define %readymedia-log-dir "/var/log/readymedia")
+(define %readymedia-user-account "readymedia")
+(define %readymedia-user-group "readymedia")
+
+(define-record-type* <readymedia-configuration>
+  readymedia-configuration make-readymedia-configuration
+  readymedia-configuration?
+  (readymedia readymedia-configuration-readymedia (default readymedia))
+  (friendly-name readymedia-configuration-friendly-name (default #f))
+  (media-dirs readymedia-configuration-media-dirs)
+  (port readymedia-configuration-port (default #f))
+  (extra-config readymedia-configuration-extra-config (default '())))
+
+;; READYMEDIA-MEDIA-DIR is a record that indicates path and media type of a
+;; media folder. The media type string can be empty (no media type specified),
+;; one character (a single media type, e.g. "A" for audio only), or more
+;; characters (mixed media types, e.g. "PV" for pictures and video). The 
allowed
+;; individual types are A for audio, P for pictures, V for video.
+(define-record-type* <readymedia-media-dir>
+  readymedia-media-dir make-readymedia-media-dir
+  readymedia-media-dir?
+  (path readymedia-media-dir-path)
+  (type readymedia-media-dir-type (default "")))
+
+(define (readymedia-media-dir->string entry)
+  "Convert a media-dir ENTRY to a ReadyMedia/MiniDLNA media dir string."
+  (format #f
+          "media_dir=~a,~a"
+          (readymedia-media-dir-type entry)
+          (readymedia-media-dir-path entry)))
+
+(define (readymedia-configuration->config-file config)
+  "Return the ReadyMedia/MiniDLNA configuration file corresponding to CONFIG."
+  (let ((friendly-name (readymedia-configuration-friendly-name config))
+        (media-dirs (readymedia-configuration-media-dirs config))
+        (port (readymedia-configuration-port config))
+        (extra-config (readymedia-configuration-extra-config config)))
+    (plain-file
+     "minidlna.conf"
+     (string-append
+      "db_dir=" %readymedia-cache-dir "\n"
+      "log_dir=" %readymedia-log-dir "\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-dir->string media-dirs) "\n" 'suffix)
+      (string-join 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-dirs (readymedia-configuration-media-dirs config))
+         (readymedia (least-authority-wrapper
+                      (file-append
+                       (readymedia-configuration-readymedia config)
+                       "/sbin/minidlnad")
+                      #:name "minidlna"
+                      #:mappings (cons*
+                                  (file-system-mapping
+                                   (source %readymedia-cache-dir)
+                                   (target source)
+                                   (writable? #t))
+                                  (file-system-mapping
+                                   (source %readymedia-log-dir)
+                                   (target source)
+                                   (writable? #t))
+                                  (file-system-mapping
+                                   (source minidlna-conf)
+                                   (target source))
+                                  (map
+                                   (lambda (e)
+                                     (file-system-mapping
+                                      (source (readymedia-media-dir-path e))
+                                      (target source)
+                                      (writable? #f)))
+                                   media-dirs))
+                      #: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")
+                     #:user "readymedia"
+                     #:group "readymedia"))
+           (stop #~(make-kill-destructor))))))
+
+(define readymedia-accounts
+  (list (user-group
+         (name %readymedia-user-group)
+         (system? #t))
+        (user-account
+         (name %readymedia-user-account)
+         (group %readymedia-user-group)
+         (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."
+  #~(begin
+      (use-modules (guix build utils))
+      (define %user (getpw #$%readymedia-user-account))
+      (mkdir-p #$%readymedia-cache-dir)
+      (chown #$%readymedia-cache-dir (passwd:uid %user) (passwd:gid %user))
+      (mkdir-p #$%readymedia-log-dir)
+      (chown #$%readymedia-log-dir (passwd:uid %user) (passwd:gid %user))))
+
+(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.")))

base-commit: 46a64c7fdd057283063aae6df058579bb07c4b6a
prerequisite-patch-id: d27309b891fb770961716c2ea652ac911cb58433
-- 
2.45.2