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

[Fabio Natali via Guix-patches via <guix-patches@gnu.org>]

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

Change-Id: I80b02235ec36b7a1ea85fea98bdc9e08126b09a3
---
Ok, brilliant, thanks Arun.

I'm sending a v4 then where I switch back to non-configurable ReadyMedia user
and group. The patch also fixes the logging mechanism - in the previous versions
the logging file was configurable but the service didn't make use of it.

If you want to give this a last check in a VM, as per my previous messages in
this thread, here's the relevant instructions.

Create a folder, e.g. '/tmp/foo', and populate it with at least one music file,
e.g. '/tmp/foo/foo.mp3'.

Create a system definition that includes the ReadyMedia service:

--8<---------------cut here---------------start------------->8---
  (services (cons*
             (service gnome-desktop-service-type)
             (service readymedia-service-type
                      (readymedia-configuration
                       (media-directories
                        (list
                         (readymedia-media-directory (path "/music")
                                                     (type 'A))))))
             %desktop-services)))
--8<---------------cut here---------------end--------------->8---

From within the Guix repository checkout, once the ReadyMedia service patch has
been applied, build and launch a VM with:

--8<---------------cut here---------------start------------->8---
$(./pre-inst-env guix system vm --share=/tmp/foo=/music CONFIG) -m 2048 -smp 2
--8<---------------cut here---------------end--------------->8---

From the VM, you should be able to verify that the ReadyMedia service is running
with 'sudo herd status'.

If available as a package in the VM, you should be able to use VLC to connect to
the ReadyMedia service and play music from the '/tmp/foo' folder. You may want
to follow these instructions https://www.vlchelp.com/access-media-upnp-dlna/.

Let me know if you spot anything. If either of you are happy with it and want to
gently push it upstream... that'd be fab.

Thanks for all the help. Best, F.


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

diff --git a/doc/guix.texi b/doc/guix.texi
index fcaf6b3fbb..ddc997b6bf 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,112 @@ 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")
+                                            (type 'A))
+                (readymedia-media-directory (path "/media/video")
+                                            (type '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 @code{path} and,
+optionally, a media type string.
+
+@table @asis
+@item @code{path} (type: string)
+The media folder location.
+
+@item @code{type} (default: @code{#f}) (type: maybe-symbol)
+Valid media types are @code{'A} for audio, @code{'P} for pictures,
+@code{'V} for video, and a combination of those individual symbols for
+mixed types.  False means no type specified.
+
+@end table
+
+@end deftp
 
 @c %end of fragment
 
diff --git a/gnu/local.mk b/gnu/local.mk
index ad5494fe95..ef4e6d006f 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				\
diff --git a/gnu/services/upnp.scm b/gnu/services/upnp.scm
new file mode 100644
index 0000000000..779da27837
--- /dev/null
+++ b/gnu/services/upnp.scm
@@ -0,0 +1,205 @@
+;;; 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-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-type
+            readymedia-media-directory?
+            readymedia-service-type))
+
+;;; Commentary:
+;;;
+;;; UPnP services.
+;;;
+;;; Code:
+
+(define %readymedia-user-group "readymedia")
+(define %readymedia-user-account "readymedia")
+(define %readymedia-log-file "minidlna.log")
+
+(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 "/var/cache/readymedia"))
+  (log-directory readymedia-configuration-log-directory
+           (default "/var/log/readymedia"))
+  (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 path and media type of a
+;; media folder. Type can be false (no media type specified) or a symbol
+;; (e.g. 'A' for audio, 'V' for video, 'AV' for audio and video). The allowed
+;; individual types are 'A' for audio, 'P' for pictures, 'V' for video.
+(define-record-type* <readymedia-media-directory>
+  readymedia-media-directory make-readymedia-media-directory
+  readymedia-media-directory?
+  (path readymedia-media-directory-path)
+  (type readymedia-media-directory-type (default #f)))
+
+(define (readymedia-media-directory-type->string type)
+  "Convert a media-directory TYPE to a string."
+  (match type
+    (#f "")
+    (symbol (symbol->string type))))
+
+(define (readymedia-media-directory->string entry)
+  "Convert a media-directory ENTRY to a ReadyMedia/MiniDLNA media dir string."
+  (let ((type (readymedia-media-directory-type entry)))
+    (format #f
+            "media_dir=~a,~a"
+            (readymedia-media-directory-type->string type)
+            (readymedia-media-directory-path entry))))
+
+(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
+            #~(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 #$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.")))

base-commit: ed4e0b48f16530def08862657301178b5cf00a9a
-- 
2.45.2