unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#72398] [PATCH] services: Add readymedia-service-type.
@ 2024-07-31 10:27 Fabio Natali via Guix-patches via
  2024-08-12 23:19 ` Arun Isaac
                   ` (3 more replies)
  0 siblings, 4 replies; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-07-31 10:27 UTC (permalink / raw)
  To: 72398
  Cc: Fabio Natali, Florian Pelz, Ludovic Courtès,
	Matthew Trzcinski, Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-07-31 10:27 [bug#72398] [PATCH] services: Add readymedia-service-type Fabio Natali via Guix-patches via
@ 2024-08-12 23:19 ` Arun Isaac
  2024-08-19  0:27   ` Fabio Natali via Guix-patches via
  2024-08-22 10:17 ` [bug#72398] [PATCH v3] " Fabio Natali via Guix-patches via
                   ` (2 subsequent siblings)
  3 siblings, 1 reply; 29+ messages in thread
From: Arun Isaac @ 2024-08-12 23:19 UTC (permalink / raw)
  To: 72398; +Cc: Fabio Natali


Hi Fabio,

Thank you for the patch. That's an excellent patch for a first Guix
service! I can only suggest a few minor improvements (mostly nitpicks
really).

Could you also suggest some quick way for me to test this service
without actually having to reconfigure my system? Can I, for example,
put it in a Guix system container or VM and test it that way?

> +(define %readymedia-cache-dir "/var/cache/readymedia")
> +(define %readymedia-log-dir "/var/log/readymedia")

Can we have these two in the <readymedia-configuration> record?

> +(define %readymedia-user-account "readymedia")
> +(define %readymedia-user-group "readymedia")

These are fine as they are.

> +  (readymedia readymedia-configuration-readymedia (default
> readymedia))

Nitpick: Just to be consistent with other services, I would indent this
(and the other fields) like so with the default on the next line:

>   (readymedia readymedia-configuration-readymedia
>               (default readymedia))

> +(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)))))

Could you use mixed-text-file here instead of plain-file? Or, you could
also try computed-file if that's more succinct.

> +(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))

Re-format by putting the first file-system-mapping on the same line as
the cons*. It's customary to format lisp function calls that way. It
makes it easier to see what the arguments are.

> +                                  (map
> +                                   (lambda (e)
> +                                     (file-system-mapping
> +                                      (source (readymedia-media-dir-path e))
> +                                      (target source)
> +                                      (writable? #f)))

Likwise with map. Put the lambda on the same line as the map.

Looking forward to a v2 patch!

Regards,
Arun




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-08-12 23:19 ` Arun Isaac
@ 2024-08-19  0:27   ` Fabio Natali via Guix-patches via
  2024-08-20  2:14     ` [bug#72398] [PATCH v2] " Bruno Victal
  0 siblings, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-08-19  0:27 UTC (permalink / raw)
  To: Arun Isaac, 72398

[-- Attachment #1: Type: text/plain, Size: 3829 bytes --]

Hey Arun,

Thanks for reviewing the patch and for the useful feedback, I really
appreciate it! Please find my comments/answers below. Patch v2 is
attached.

On 2024-08-13, 00:19 +0100, Arun Isaac <arunisaac@systemreboot.net> wrote:
> Could you also suggest some quick way for me to test this service
> without actually having to reconfigure my system?

Good point. There might be more clever ways to go about it, but here's
my testing process.

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

- Save this system definition in a file, e.g. '/tmp/config.scm'. Note
  the insecure user credentials.

(use-modules (gnu))
(use-package-modules video)
(use-service-modules desktop upnp)

(operating-system
  (host-name "host")
  (bootloader (bootloader-configuration
               (bootloader grub-bootloader)
               (targets '("/dev/vda"))))
  (file-systems (cons (file-system
                        (device "/dev/vda1")
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
  (users (cons*
          (user-account (name "user")
                        (group "users")
                        (supplementary-groups '("wheel"))
                        (password (crypt "password" "foo")))
          %base-user-accounts))
  (sudoers-file (plain-file
                 "sudoers"
                 (string-append
                  (plain-file-content %sudoers-specification)
                  "%wheel ALL = NOPASSWD: ALL")))
  (packages (cons* vlc %base-packages))
  (services (cons*
             (service gnome-desktop-service-type)
             (service readymedia-service-type
                      (readymedia-configuration
                       (media-dirs
                        (list
                         (readymedia-media-dir (path "/media/music")
                                               (type "A"))))))
             %desktop-services)))

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

$(./pre-inst-env guix system vm \
    --share=/tmp/foo=/media/music \
    /tmp/config.scm) -m 2048 -smp 2

- Log in as 'user'. Open a terminal and verify that the ReadyMedia
  service is running with 'sudo herd status'.

- Open VLC and follow these instructions
  https://www.vlchelp.com/access-media-upnp-dlna/ to verify that the
  ReadyMedia service is running and that the 'foo.mp3' file can be
  played.

- Open a browser and verify that the ReadyMedia web page is also
  reachable at 'http://127.0.0.1:8200'.

This should be it, testing-wise.

>> +(define %readymedia-cache-dir "/var/cache/readymedia")
>> +(define %readymedia-log-dir "/var/log/readymedia")
>
> Can we have these two in the <readymedia-configuration> record?

Fixed in v2.

> Nitpick: Just to be consistent with other services, I would indent
> this (and the other fields) like so with the default on the next line:
>
>>   (readymedia readymedia-configuration-readymedia
>>               (default readymedia))

Fixed.

>> +(define (readymedia-configuration->config-file config)

> Could you use mixed-text-file here instead of plain-file? Or, you
> could also try computed-file if that's more succinct.

'mixed-text-file' improves things a bit, see v2. WDYT?

>> +(define (readymedia-shepherd-service config)

> Re-format by putting the first file-system-mapping on the same line as
> the cons*. It's customary to format lisp function calls that way. It
> makes it easier to see what the arguments are.

Fixed.

> Likwise with map. Put the lambda on the same line as the map.

Fixed.

> Looking forward to a v2 patch!

v2 attached. :)

Thanks Arun, let me know what you think. Should you spot anything else
just let me know.

Cheers, F.


[-- Attachment #2: 0001-services-Add-readymedia-service-type.patch --]
[-- Type: text/x-patch, Size: 13870 bytes --]

From ce75351ca7a1f30487e525b7d543ca010d765303 Mon Sep 17 00:00:00 2001
Message-ID: <ce75351ca7a1f30487e525b7d543ca010d765303.1724026903.git.me@fabionatali.com>
From: Fabio Natali <me@fabionatali.com>
Date: Mon, 19 Aug 2024 01:20:13 +0100
Subject: [PATCH] services: Add readymedia-service-type.

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

Change-Id: I80b02235ec36b7a1ea85fea98bdc9e08126b09a3
---
 doc/guix.texi         | 103 ++++++++++++++++++++++++
 gnu/local.mk          |   1 +
 gnu/services/upnp.scm | 180 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 284 insertions(+)
 create mode 100644 gnu/services/upnp.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 0e1e253b02..ff07d3c6e2 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
@@ -41599,6 +41600,108 @@ 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{cache-dir} (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-dir} (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: 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 86ff662efa..c850ffbffe 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..076fd4159f
--- /dev/null
+++ b/gnu/services/upnp.scm
@@ -0,0 +1,180 @@
+;;; 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-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))
+  (cache-dir readymedia-configuration-cache-dir
+             (default "/var/cache/readymedia"))
+  (log-dir readymedia-configuration-log-dir
+           (default "/var/log/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))
+        (cache-dir (readymedia-configuration-cache-dir config))
+        (log-dir (readymedia-configuration-log-dir config))
+        (port (readymedia-configuration-port config))
+        (extra-config (readymedia-configuration-extra-config config)))
+    (mixed-text-file
+     "minidlna.conf"
+     "db_dir=" cache-dir "\n"
+     "log_dir=" 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))
+         (cache-dir (readymedia-configuration-cache-dir config))
+         (log-dir (readymedia-configuration-log-dir config))
+         (readymedia (least-authority-wrapper
+                      (file-append
+                       (readymedia-configuration-readymedia config)
+                       "/sbin/minidlnad")
+                      #:name "minidlna"
+                      #:mappings (cons* (file-system-mapping
+                                         (source cache-dir)
+                                         (target source)
+                                         (writable? #t))
+                                        (file-system-mapping
+                                         (source 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."
+  (let ((cache-dir (readymedia-configuration-cache-dir config))
+        (log-dir (readymedia-configuration-log-dir config)))
+    #~(begin
+        (use-modules (guix build utils))
+        (define %user (getpw #$%readymedia-user-account))
+        (mkdir-p #$cache-dir)
+        (chown #$cache-dir (passwd:uid %user) (passwd:gid %user))
+        (mkdir-p #$log-dir)
+        (chown #$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: 71f0676a295841e2cc662eec0d3e9b7e69726035
-- 
2.45.2


^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v2] services: Add readymedia-service-type.
  2024-08-19  0:27   ` Fabio Natali via Guix-patches via
@ 2024-08-20  2:14     ` Bruno Victal
  2024-08-22 10:13       ` Fabio Natali via Guix-patches via
  2024-08-22 23:22       ` Arun Isaac
  0 siblings, 2 replies; 29+ messages in thread
From: Bruno Victal @ 2024-08-20  2:14 UTC (permalink / raw)
  To: Fabio Natali; +Cc: Arun Isaac, 72398

Hi Fabio,

On 2024-08-19 01:27, Fabio Natali via Guix-patches via wrote:
> +(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"))))))

[…]

> +@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{cache-dir} (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-dir} (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.

Expand these to media-directories, cache-directory, etc.

> +@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.

Do you have an example on this?
Given the description perhaps an alist would work better here.

> +
> +@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.

Likewise, expand to readymedia-media-directory.

> +
> +@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.

I'd use a list of symbols (or enum) here.

> +(define %readymedia-user-account "readymedia")
> +(define %readymedia-user-group "readymedia")

I think it would be better to expose this in the
readymedia-configuration record-type and have it be oriented
around user-account and user-group record-types, i.e.

--8<---------------cut here---------------start------------->8---
(define %readymedia-user-group
  (user-group
    (name "readymedia")
    (system? #t)))

(define %readymedia-user-account
  (user-account
    (name "readymedia")
    (group "readymedia")
    (system? #t)
    (comment "ReadyMedia/MiniDLNA daemon user")
    (home-directory "/var/empty")
    (shell (file-append shadow "/sbin/nologin"))))

(define-record-type* <readymedia-configuration> …
  …
  (user readymedia-configuration-user
        (default %readymedia-user-account))
  (group readymedia-configuration-group
        (default %readymedia-user-group))))

(define (readymedia-account-service config)
  (match-record config <readymedia-configuration> (group user)
    (list group user)))

;; … and adjust service-type extension accordingly
--8<---------------cut here---------------end--------------->8---

This way you can allow for users to fine-tune the account permissions, 
groups & co. used by readymedia.

> +(define (readymedia-activation config)
> +  "Set up directories for ReadyMedia/MiniDLNA."
> +  (let ((cache-dir (readymedia-configuration-cache-dir config))
> +        (log-dir (readymedia-configuration-log-dir config)))
> +    #~(begin
> +        (use-modules (guix build utils))
> +        (define %user (getpw #$%readymedia-user-account))
> +        (mkdir-p #$cache-dir)
> +        (chown #$cache-dir (passwd:uid %user) (passwd:gid %user))
> +        (mkdir-p #$log-dir)
> +        (chown #$log-dir (passwd:uid %user) (passwd:gid %user)))))

I'd avoid using activation-service-type since it doesn't account for
shepherd dependencies (which implies file-system mounts), consequence
being that this service will be broken if any of these directories
happen to be located outside of the root filesystem.
(My advice is to avoid using activation-service-type unless you're
sure of how the chain of action in guix+shepherd goes)

Instead, do these within the start action of shepherd-service,
see the "prologue"/(before make-forkexec-constructor is called) of
mympd-service-type in gnu/services/audio.scm for an idea [1].

[1]: https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/services/audio.scm?id=00245fdcd4909d7e6b20fe88f5d089717115adc1#n919

-- 
Cheers,
Bruno.





^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v2] services: Add readymedia-service-type.
  2024-08-20  2:14     ` [bug#72398] [PATCH v2] " Bruno Victal
@ 2024-08-22 10:13       ` Fabio Natali via Guix-patches via
  2024-08-22 23:28         ` Arun Isaac
  2024-08-22 23:22       ` Arun Isaac
  1 sibling, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-08-22 10:13 UTC (permalink / raw)
  To: Bruno Victal; +Cc: Arun Isaac, 72398

Hi Bruno,

Thanks for providing feedback on this and thanks for the help provided
on IRC. I've gone through your comments and did my best to address
them. See my replies inline below.

On 2024-08-20, 03:14 +0100, Bruno Victal <mirai@makinata.eu> wrote:
>> +@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{cache-dir} (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-dir} (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.
>
> Expand these to media-directories, cache-directory, etc.

Good point, now fixed.

>> +@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.
>
> Do you have an example on this?
> Given the description perhaps an alist would work better here.

True, great point. That's now an alist. Example added too.

>> +@deftp {Data Type} readymedia-media-dir
>> +A @code{media-dirs} entry includes a @code{path} and, optionally, a
>> +media type string.
>
> Likewise, expand to readymedia-media-directory.

Fixed.

>> +@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.
>
> I'd use a list of symbols (or enum) here.

Fixed, switched to symbols.

>> +(define %readymedia-user-account "readymedia")
>> +(define %readymedia-user-group "readymedia")
>
> I think it would be better to expose this in the
> readymedia-configuration record-type and have it be oriented around
> user-account and user-group record-types, i.e.
[...]
> This way you can allow for users to fine-tune the account permissions,
> groups & co. used by readymedia.

Fixed, although I'm not sure I'm 100% on board with this.

I'm not completely sure but I have the feeling that a configurable
ReadyMedia user might theoretically weaken the POLA, e.g. if the user
chose their own user for this service.

Following up on a related conversation we started on IRC, I suppose we
should either go all in with flexibility (i.e. allow the user to switch
off the least-authority-wrapper and set the service user) or adopt a
slightly more rigid approach (mandated POLA and fixed user).

I think I might have a slight preference for the latter, prioritising
compartmentalisation over flexibility - but I'm keen to know what you,
Arun, and all other Guixers may think about this.

I'm glad to send a new version in case, where I switch back to a
mandated, non-configurable 'readymedia' user.

>> +(define (readymedia-activation config)
>> +  "Set up directories for ReadyMedia/MiniDLNA."
[...]
> I'd avoid using activation-service-type since it doesn't account for
> shepherd dependencies (which implies file-system mounts), consequence
> being that this service will be broken if any of these directories
> happen to be located outside of the root filesystem.
> (My advice is to avoid using activation-service-type unless you're
> sure of how the chain of action in guix+shepherd goes)

Ha, ok, I'd have never thought of this! With a bit of a
don't-know-what-i'm-doing feeling, I might have fixed this too. :)

Thanks to you and Arun for all the helpful feedback!

I hope v3 is in a better shape now (to follow shortly).

Thanks, cheers, Fabio.




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v3] services: Add readymedia-service-type.
  2024-07-31 10:27 [bug#72398] [PATCH] services: Add readymedia-service-type Fabio Natali via Guix-patches via
  2024-08-12 23:19 ` Arun Isaac
@ 2024-08-22 10:17 ` Fabio Natali via Guix-patches via
  2024-10-15 15:31 ` [bug#72398] [PATCH v7] " Fabio Natali via Guix-patches via
  2024-10-18  1:19 ` [bug#72398] [PATCH v8] " Arun Isaac
  3 siblings, 0 replies; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-08-22 10:17 UTC (permalink / raw)
  To: 72398
  Cc: arunisaac, mirai, Fabio Natali, Florian Pelz,
	Ludovic Courtès, Matthew Trzcinski, Maxim Cournoyer

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

Change-Id: I80b02235ec36b7a1ea85fea98bdc9e08126b09a3
---
Hi,

Here's a short recap of how to test this.

Save this system definition in a file, e.g. '/tmp/config.scm'. Note the insecure
user credentials.

(use-modules (gnu))
(use-package-modules video)
(use-service-modules desktop upnp)

(define %test-user-account
  (user-account (name "test")
                (group "users")
                (supplementary-groups '("wheel"))
                (password (crypt "password" "foo"))))

(operating-system
  (host-name "host")
  (bootloader (bootloader-configuration
               (bootloader grub-bootloader)
               (targets '("/dev/vda"))))
  (file-systems (cons (file-system
                        (device "/dev/vda1")
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
  (users (cons*
          %test-user-account
          %base-user-accounts))
  (sudoers-file (plain-file
                 "sudoers"
                 (string-append
                  (plain-file-content %sudoers-specification)
                  "%wheel ALL = NOPASSWD: ALL")))
  (packages (cons* vlc %base-packages))
  (services (cons*
             (service gnome-desktop-service-type)
             (service readymedia-service-type
                      (readymedia-configuration
                       (user %test-user-account)
                       (media-directories
                        (list
                         (readymedia-media-directory (path "/media/music")
                                                     (type 'A))))))
             %desktop-services)))

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

$(./pre-inst-env guix system vm \
    --share=/tmp/foo=/media/music \
    /tmp/config.scm) -m 2048 -smp 2

Log in as 'user'. Open a terminal and verify that the ReadyMedia service is
running with 'sudo herd status'.

Open VLC and follow these instructions
https://www.vlchelp.com/access-media-upnp-dlna/to verify that the ReadyMedia
service is running and that the 'foo.mp3' file can be played.

Open a browser and verify that the ReadyMedia web page is also reachable at
'http://127.0.0.1:8200'.

More comments in my previous email to this same thread.

Thanks, cheers, Fabio.


 doc/guix.texi         | 107 +++++++++++++++++++++
 gnu/local.mk          |   1 +
 gnu/services/upnp.scm | 211 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 319 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 11dff1c6c4..336ca14bbe 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..5f8e5ac8b0
--- /dev/null
+++ b/gnu/services/upnp.scm
@@ -0,0 +1,211 @@
+;;; 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-configuration
+            readymedia-configuration-cache-directory
+            readymedia-configuration-extra-config
+            readymedia-configuration-friendly-name
+            readymedia-configuration-group
+            readymedia-configuration-log-directory
+            readymedia-configuration-media-directories
+            readymedia-configuration-port
+            readymedia-configuration-readymedia
+            readymedia-configuration-user
+            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
+  (user-group
+   (name "readymedia")
+   (system? #t)))
+
+(define %readymedia-user-account
+  (user-account
+   (name "readymedia")
+   (group "readymedia")
+   (system? #t)
+   (comment "ReadyMedia/MiniDLNA daemon user")
+   (home-directory "/var/empty")
+   (shell (file-append shadow "/sbin/nologin"))))
+
+(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))
+  (user readymedia-configuration-user
+        (default %readymedia-user-account))
+  (group readymedia-configuration-group
+         (default %readymedia-user-group))
+  (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))
+         (user (readymedia-configuration-user config))
+         (group (readymedia-configuration-group 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-id (getpw #$(user-account-name user)))
+                       (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-id #o755)))))
+                  (for-each init-directory dirs))
+                (make-forkexec-constructor
+                 ;; "-S" is to daemonise minidlnad.
+                 (list #$readymedia "-f" #$minidlna-conf "-S")
+                 #:user #$(user-account-name user)
+                 #:group #$(user-group-name group))))
+           (stop #~(make-kill-destructor))))))
+
+(define (readymedia-account-service config)
+  (match-record config <readymedia-configuration>
+                (group user)
+                (list group 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 readymedia-account-service)))
+   (description
+    "Run @command{minidlnad}, the ReadyMedia/MiniDLNA media server.")))

base-commit: 2c7119b43bd44ee812ceaa2351bff9a8b623a920
-- 
2.45.2





^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v2] services: Add readymedia-service-type.
  2024-08-20  2:14     ` [bug#72398] [PATCH v2] " Bruno Victal
  2024-08-22 10:13       ` Fabio Natali via Guix-patches via
@ 2024-08-22 23:22       ` Arun Isaac
  1 sibling, 0 replies; 29+ messages in thread
From: Arun Isaac @ 2024-08-22 23:22 UTC (permalink / raw)
  To: Bruno Victal, Fabio Natali; +Cc: 72398


> I'd avoid using activation-service-type since it doesn't account for
> shepherd dependencies (which implies file-system mounts), consequence
> being that this service will be broken if any of these directories
> happen to be located outside of the root filesystem.  (My advice is to
> avoid using activation-service-type unless you're sure of how the
> chain of action in guix+shepherd goes)

This is a good point. I hadn't thought of this.

> Instead, do these within the start action of shepherd-service,
> see the "prologue"/(before make-forkexec-constructor is called) of
> mympd-service-type in gnu/services/audio.scm for an idea [1].

And, a clever solution too. Today I learnt!




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v2] services: Add readymedia-service-type.
  2024-08-22 10:13       ` Fabio Natali via Guix-patches via
@ 2024-08-22 23:28         ` Arun Isaac
  2024-08-23 11:04           ` [bug#72398] [PATCH v4] " Fabio Natali via Guix-patches via
  2024-08-23 15:25           ` [bug#72398] [PATCH v2] " Bruno Victal
  0 siblings, 2 replies; 29+ messages in thread
From: Arun Isaac @ 2024-08-22 23:28 UTC (permalink / raw)
  To: Fabio Natali, Bruno Victal; +Cc: 72398


>>> +(define %readymedia-user-account "readymedia")
>>> +(define %readymedia-user-group "readymedia")
>>
>> I think it would be better to expose this in the
>> readymedia-configuration record-type and have it be oriented around
>> user-account and user-group record-types, i.e.
>
> Fixed, although I'm not sure I'm 100% on board with this.
>
> I'm not completely sure but I have the feeling that a configurable
> ReadyMedia user might theoretically weaken the POLA, e.g. if the user
> chose their own user for this service.
>
> Following up on a related conversation we started on IRC, I suppose we
> should either go all in with flexibility (i.e. allow the user to switch
> off the least-authority-wrapper and set the service user) or adopt a
> slightly more rigid approach (mandated POLA and fixed user).
>
> I think I might have a slight preference for the latter, prioritising
> compartmentalisation over flexibility - but I'm keen to know what you,
> Arun, and all other Guixers may think about this.

I am with Fabio on this. Many (almost all, maybe?) services use a fixed
user account that cannot be configured. And, that's ok.

I don't think we should make the least authority wrapper optional
either. Making it optional would be too much complexity for little
benefit. The goal of Guix services isn't to provide total
configurability, but rather to be slightly opinionated so as to nudge
users in the right direction.

Let me know if I'm missing something important.

Cheers!




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v4] services: Add readymedia-service-type.
  2024-08-22 23:28         ` Arun Isaac
@ 2024-08-23 11:04           ` Fabio Natali via Guix-patches via
  2024-08-23 15:35             ` Bruno Victal
  2024-08-23 15:25           ` [bug#72398] [PATCH v2] " Bruno Victal
  1 sibling, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-08-23 11:04 UTC (permalink / raw)
  To: 72398
  Cc: arunisaac, mirai, Fabio Natali, Florian Pelz,
	Ludovic Courtès, Matthew Trzcinski, Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v2] services: Add readymedia-service-type.
  2024-08-22 23:28         ` Arun Isaac
  2024-08-23 11:04           ` [bug#72398] [PATCH v4] " Fabio Natali via Guix-patches via
@ 2024-08-23 15:25           ` Bruno Victal
  2024-08-28 22:51             ` Arun Isaac
  1 sibling, 1 reply; 29+ messages in thread
From: Bruno Victal @ 2024-08-23 15:25 UTC (permalink / raw)
  To: Arun Isaac, Fabio Natali; +Cc: 72398

Hi Arun,

On 2024-08-23 00:28, Arun Isaac wrote:
> 
>>>> +(define %readymedia-user-account "readymedia")
>>>> +(define %readymedia-user-group "readymedia")
>>>
>>> I think it would be better to expose this in the
>>> readymedia-configuration record-type and have it be oriented around
>>> user-account and user-group record-types, i.e.
>>
>> Fixed, although I'm not sure I'm 100% on board with this.
>>
>> I'm not completely sure but I have the feeling that a configurable
>> ReadyMedia user might theoretically weaken the POLA, e.g. if the user
>> chose their own user for this service.
>>
>> Following up on a related conversation we started on IRC, I suppose we
>> should either go all in with flexibility (i.e. allow the user to switch
>> off the least-authority-wrapper and set the service user) or adopt a
>> slightly more rigid approach (mandated POLA and fixed user).
>>
>> I think I might have a slight preference for the latter, prioritising
>> compartmentalisation over flexibility - but I'm keen to know what you,
>> Arun, and all other Guixers may think about this.
> 
> I am with Fabio on this. Many (almost all, maybe?) services use a fixed
> user account that cannot be configured. And, that's ok.

Without delving into the quantifying, there's at least a few of them
that offer this feature. (in my experience, I've had to rely on this for a
few services already so it's not merely a theoretical concern)

Should you ever need to "tweak" a fixed user-account service
you're going to end up with something like [1] (beginning from line 21,
rationale given at line 39). Not exactly desirable and although the
example above pertains to nginx + cgit if I'm not mistaken, a similar
situation arises in the following (fictional) setup:

/media/NFS/my-media/…             (owner: foo, group: bigmedia, #o750)
/media/jumbodisk/my-media/…       (owner: bar, group: bigmedia, #o750)
/media/something-else/library/…   (owner: baz, group: bigmedia, #o750)

and wholesame chown'ing them to "readymedia" wouldn't make sense/be
a good idea (say, each of the directories is under control by a
downloader/synchronizing daemon with it's own user-account).

> I don't think we should make the least authority wrapper optional
> either. Making it optional would be too much complexity for little
> benefit. (…)

I don't think so, it amounts to:
• a boolean field named least-authority-wrapped? in the configuration record-type
• an if statement, e.g. (if least-authority-wrapped? (least-authority-wrapper …) readymedia)

As for the reason of this, consider a setup where the media directories
contain symlinks to directories outside of it. It can be infeasible to
duplicate the files or "just move them then", in those cases an escape
hatch makes sense to be. It's not as secure as the least-authority wrapped
 one but that's a compromise opted in by the user.

> (…) The goal of Guix services isn't to provide total
> configurability, but rather to be slightly opinionated so as to nudge
> users in the right direction.

I'm not against this idea, just pointing out that it's overly rigid right
now and that users with a non "uniform" setup will simply resort to
harder to understand manipulations like [1] or wholesale duplicate
gnu/services/upnp.scm and tweak it themselves.

Let me know if there's anything I missed,


[1]: <https://git.dthompson.us/guix-config/tree/dthompson/machines/takemi.scm?id=b14a123560dbfc4b7b9ceedf12cc5730558e2418#n39>

-- 
Cheers,
Bruno.





^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v4] services: Add readymedia-service-type.
  2024-08-23 11:04           ` [bug#72398] [PATCH v4] " Fabio Natali via Guix-patches via
@ 2024-08-23 15:35             ` Bruno Victal
  2024-08-26 10:11               ` [bug#72398] [PATCH v5] " Fabio Natali via Guix-patches via
  0 siblings, 1 reply; 29+ messages in thread
From: Bruno Victal @ 2024-08-23 15:35 UTC (permalink / raw)
  To: Fabio Natali; +Cc: arunisaac, 72398

On 2024-08-23 12:04, Fabio Natali via Guix-patches via wrote:

> Here's a short recap of how to test this.
> 
> Save this system definition in a file, e.g. '/tmp/config.scm'. Note the insecure
> user credentials.

Think you can go the extra step and write a system test for this?
That'd greatly simplify future checks and ease the maintenance burden
as well.

> +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"))))

Since the types can be a combination, you're going to want to express these
as a list, e.g.

--8<---------------cut here---------------start------------->8---
 (type '(A))
 (type '(A P))
 …
--8<---------------cut here---------------end--------------->8---

an empty list being the default value standing for "no type specified"
if I got the meaning right from the documentation.


-- 
Cheers,
Bruno.





^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v5] services: Add readymedia-service-type.
  2024-08-23 15:35             ` Bruno Victal
@ 2024-08-26 10:11               ` Fabio Natali via Guix-patches via
  2024-09-06 22:17                 ` Ludovic Courtès
  0 siblings, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-08-26 10:11 UTC (permalink / raw)
  To: 72398
  Cc: arunisaac, mirai, Fabio Natali, Florian Pelz,
	Ludovic Courtès, Matthew Trzcinski, Maxim Cournoyer

* 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 <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
+  (string-append %readymedia-default-log-directory "/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))
+         (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 <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-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





^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v2] services: Add readymedia-service-type.
  2024-08-23 15:25           ` [bug#72398] [PATCH v2] " Bruno Victal
@ 2024-08-28 22:51             ` Arun Isaac
  2024-08-29 14:37               ` Fabio Natali via Guix-patches via
  0 siblings, 1 reply; 29+ messages in thread
From: Arun Isaac @ 2024-08-28 22:51 UTC (permalink / raw)
  To: Bruno Victal, Fabio Natali; +Cc: 72398


Hi Bruno,

>> I am with Fabio on this. Many (almost all, maybe?) services use a fixed
>> user account that cannot be configured. And, that's ok.
>
> Without delving into the quantifying, there's at least a few of them
> that offer this feature. (in my experience, I've had to rely on this for a
> few services already so it's not merely a theoretical concern)
>
> Should you ever need to "tweak" a fixed user-account service
> you're going to end up with something like [1] (beginning from line 21,
> rationale given at line 39). Not exactly desirable and although the
> example above pertains to nginx + cgit if I'm not mistaken, a similar
> situation arises in the following (fictional) setup:
>
> /media/NFS/my-media/…             (owner: foo, group: bigmedia, #o750)
> /media/jumbodisk/my-media/…       (owner: bar, group: bigmedia, #o750)
> /media/something-else/library/…   (owner: baz, group: bigmedia, #o750)
>
> and wholesame chown'ing them to "readymedia" wouldn't make sense/be
> a good idea (say, each of the directories is under control by a
> downloader/synchronizing daemon with it's own user-account).

You're right about this problem. It's been discussed here as well:
https://issues.guix.gnu.org/67288 But, like I mention there, I am
worried that adding configurable user and group fields to every service
isn't very composable. Ideally, we'd want to have a separate
"add-user-to-group" service that can modify configured users to have
more groups. Such a solution may be more composable. WDYT?

>> I don't think we should make the least authority wrapper optional
>> either. Making it optional would be too much complexity for little
>> benefit. (…)
>
> I don't think so, it amounts to:
> • a boolean field named least-authority-wrapped? in the configuration record-type
> • an if statement, e.g. (if least-authority-wrapped? (least-authority-wrapper …) readymedia)
>
> As for the reason of this, consider a setup where the media directories
> contain symlinks to directories outside of it. It can be infeasible to
> duplicate the files or "just move them then", in those cases an escape
> hatch makes sense to be. It's not as secure as the least-authority wrapped
>  one but that's a compromise opted in by the user.

Another solution could be to add a "mappings" field that specifies
additional directories to map into the container. I do this in some
services in
guix-forge. https://guix-forge.systemreboot.net/manual/dev/en/#item27237
It's probably not the most elegant solution, but it works without
completely disabling the container. Would this be acceptable to you?

Cheers, and happy hacking!
Arun




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v2] services: Add readymedia-service-type.
  2024-08-28 22:51             ` Arun Isaac
@ 2024-08-29 14:37               ` Fabio Natali via Guix-patches via
  0 siblings, 0 replies; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-08-29 14:37 UTC (permalink / raw)
  To: Arun Isaac, Bruno Victal; +Cc: 72398

Hi Arun, Bruno,

On 2024-08-28, 23:51 +0100, Arun Isaac <arunisaac@systemreboot.net> wrote:
> You're right about this problem. It's been discussed here as well:
> https://issues.guix.gnu.org/67288 But, like I mention there, I am
> worried that adding configurable user and group fields to every
> service isn't very composable. Ideally, we'd want to have a separate
> "add-user-to-group" service that can modify configured users to have
> more groups. Such a solution may be more composable. WDYT?

As far as I understand, a separate `add-user-to-group' service seems
like a good general way of addressing this - although outside the scope
of this patch. As a stopgap solution, I'd be glad to add a
`supplementary-groups' field a la #67288 - do you think that might work
in this context? Or we could keep the service as it is (v5) until a
`add-user-to-group' service is in place?

> Another solution could be to add a "mappings" field that specifies
> additional directories to map into the container. I do this in some
> services in
> guix-forge. https://guix-forge.systemreboot.net/manual/dev/en/#item27237

Hm, I'm sure I'm missing something here, but isn't this what the patch
does already with the "media-directories" field?

--8<---------------cut here---------------start------------->8---
(readymedia (least-authority-wrapper
             (file-append
              (readymedia-configuration-readymedia config)
              "/sbin/minidlnad")
             #:name "minidlna"
             #:mappings
             (cons*
                    ...
                    (map
                     (lambda (e)
                       (file-system-mapping
                        (source (readymedia-media-directory-path e))
                        (target source)
                        (writable? #f)))
                     media-directories))
             #:namespaces (delq 'net %namespaces))))
             ...
--8<---------------cut here---------------end--------------->8---

Thanks, cheers, F.




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v5] services: Add readymedia-service-type.
  2024-08-26 10:11               ` [bug#72398] [PATCH v5] " Fabio Natali via Guix-patches via
@ 2024-09-06 22:17                 ` Ludovic Courtès
  2024-09-08 20:04                   ` [bug#72398] [PATCH v6] " Fabio Natali via Guix-patches via
  0 siblings, 1 reply; 29+ messages in thread
From: Ludovic Courtès @ 2024-09-06 22:17 UTC (permalink / raw)
  To: Fabio Natali
  Cc: arunisaac, Maxim Cournoyer, Florian Pelz, mirai, 72398,
	Matthew Trzcinski

Hello,

Fabio Natali <me@fabionatali.com> skribis:

> * doc/guix.texi: Add documentation.
> * gnu/local.mk: Add mention of new files.

This is really minor, but please mention the place where this is added,
like:

  * doc/guix.texi (Section Name): New node.

> On a Guix system tests can be run with this command:
>
> make check-system TESTS="readymedia-service"

I get two failures:

--8<---------------cut here---------------start------------->8---
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/3z061ii32vr6klh3y8p9b43zq6lwibja-readymedia-service-test-builder:1: FAIL cache file exists
/gnu/store/3z061ii32vr6klh3y8p9b43zq6lwibja-readymedia-service-test-builder:1: FAIL cache file has expected permissions
PASS: 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
PASS: log file is non-empty
PASS: ReadyMedia service is running
PASS: ReadyMedia service is listening for connections
# of expected passes      14
# of unexpected failures  2
--8<---------------cut here---------------end--------------->8---

This might have to do with activation, see below.

> +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.

> +@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.

> +    (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)))

This is problematic because the code above ‘make-forkexec-constructor’
is effectively executed as soon as shepherd reads the config file, which
may be too early or undesirable.

If you intended it to run when the service is started, you’ll have to
structure it like this:

  (start #~(lambda ()
             ;; create directories etc.
             (fork+exec-command (list #$readymedia …) …)))

Also, use the ‘modules’ field instead of ‘use-modules’ right in the
middle.

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.

> +(define %test-readymedia-service

Just ‘%test-readymedia’…

> +  (system-test
> +   (name "readymedia-service")

… and “readymedia”, for consistency with other tests.

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v6] services: Add readymedia-service-type.
  2024-09-06 22:17                 ` Ludovic Courtès
@ 2024-09-08 20:04                   ` Fabio Natali via Guix-patches via
  2024-10-13 17:34                     ` Fabio Natali via Guix-patches via
  0 siblings, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-09-08 20:04 UTC (permalink / raw)
  To: 72398; +Cc: Arun Isaac, Bruno Victal, Ludovic Courtès, Fabio Natali

* 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

diff --git a/doc/guix.texi b/doc/guix.texi
index 981ffb8c58..9b193bde23 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
 
diff --git a/gnu/local.mk b/gnu/local.mk
index ed630041ff..c65e9373f1 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -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				\
diff --git a/gnu/services/upnp.scm b/gnu/services/upnp.scm
new file mode 100644
index 0000000000..ad13f97827
--- /dev/null
+++ b/gnu/services/upnp.scm
@@ -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.")))
diff --git a/gnu/tests/upnp.scm b/gnu/tests/upnp.scm
new file mode 100644
index 0000000000..8e92594901
--- /dev/null
+++ b/gnu/tests/upnp.scm
@@ -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))))

base-commit: 123b7226a0442ee4103c04064d453421424d5fac
-- 
2.45.2




^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v6] services: Add readymedia-service-type.
  2024-09-08 20:04                   ` [bug#72398] [PATCH v6] " Fabio Natali via Guix-patches via
@ 2024-10-13 17:34                     ` Fabio Natali via Guix-patches via
  2024-10-13 22:57                       ` Arun Isaac
  0 siblings, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-10-13 17:34 UTC (permalink / raw)
  To: 72398; +Cc: Arun Isaac, Bruno Victal, Ludovic Courtès

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.


-- 
Fabio Natali
https://fabionatali.com




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v6] services: Add readymedia-service-type.
  2024-10-13 17:34                     ` Fabio Natali via Guix-patches via
@ 2024-10-13 22:57                       ` Arun Isaac
  2024-10-14 21:57                         ` [bug#72398] [PATCH] " Arun Isaac
  0 siblings, 1 reply; 29+ messages in thread
From: Arun Isaac @ 2024-10-13 22:57 UTC (permalink / raw)
  To: Fabio Natali, 72398; +Cc: Ludovic Courtès, Bruno Victal


Hi Fabio,

Sorry for the long wait. I'll push it tomorrow.

Thanks!
Arun




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-10-13 22:57                       ` Arun Isaac
@ 2024-10-14 21:57                         ` Arun Isaac
  2024-10-15 15:42                           ` Fabio Natali via Guix-patches via
  0 siblings, 1 reply; 29+ messages in thread
From: Arun Isaac @ 2024-10-14 21:57 UTC (permalink / raw)
  To: 72398, Fabio Natali; +Cc: Ludovic Courtès, Bruno Victal


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




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v7] services: Add readymedia-service-type.
  2024-07-31 10:27 [bug#72398] [PATCH] services: Add readymedia-service-type Fabio Natali via Guix-patches via
  2024-08-12 23:19 ` Arun Isaac
  2024-08-22 10:17 ` [bug#72398] [PATCH v3] " Fabio Natali via Guix-patches via
@ 2024-10-15 15:31 ` Fabio Natali via Guix-patches via
  2024-10-15 20:36   ` Arun Isaac
  2024-10-18  1:19 ` [bug#72398] [PATCH v8] " Arun Isaac
  3 siblings, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-10-15 15:31 UTC (permalink / raw)
  To: arunisaac, 72398
  Cc: ludo, mirai, Fabio Natali, Ludovic Courtès, Maxim Cournoyer

* 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: I6a3c9db9e7504df308038343ed48e4409a323581
---
Hey Arun,

Thanks for looking into this.

Are you sure you used v6 of the patch?

When I tried v6 on top of a recent checkout today, that didn't apply
straightaway because of some conflicts. I then rebased it and created the
attached v7.

v7 works fine on my system and tests can be successfully run with the command
you used: 'make check-system TESTS="readymedia"'.

Could you please try v7 on a recent checkout and see if the above works?

I feel we're getting closer! Thanks for all the help.

Best, F.


 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

diff --git a/doc/guix.texi b/doc/guix.texi
index 29bce718d4..2c5754c6c5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41773,6 +41773,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
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 5d1b316aa3..02aec3ac67 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -756,6 +756,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				\
@@ -846,6 +847,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..ad13f97827
--- /dev/null
+++ b/gnu/services/upnp.scm
@@ -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.")))
diff --git a/gnu/tests/upnp.scm b/gnu/tests/upnp.scm
new file mode 100644
index 0000000000..8e92594901
--- /dev/null
+++ b/gnu/tests/upnp.scm
@@ -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))))

base-commit: f443f5b0cd77cbbfa70cd915b4082ce32340127e
-- 
2.46.0





^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-10-14 21:57                         ` [bug#72398] [PATCH] " Arun Isaac
@ 2024-10-15 15:42                           ` Fabio Natali via Guix-patches via
  0 siblings, 0 replies; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-10-15 15:42 UTC (permalink / raw)
  To: Arun Isaac, 72398; +Cc: Ludovic Courtès, Bruno Victal

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.




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v7] services: Add readymedia-service-type.
  2024-10-15 15:31 ` [bug#72398] [PATCH v7] " Fabio Natali via Guix-patches via
@ 2024-10-15 20:36   ` Arun Isaac
  2024-10-15 20:42     ` Fabio Natali via Guix-patches via
  0 siblings, 1 reply; 29+ messages in thread
From: Arun Isaac @ 2024-10-15 20:36 UTC (permalink / raw)
  To: Fabio Natali, 72398; +Cc: ludo, mirai, Fabio Natali


Hi Fabio,

> Are you sure you used v6 of the patch?

Yep, I applied `mumi am -- -s'.

> Could you please try v7 on a recent checkout and see if the above
> works?

I applied v7 and the cache file related tests failed.

> +          (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))

I found that the cache file related tests passed when increasing the
sleep time. That's probably because my machine is just slower. This
makes this test rather fragile. I say we remove these cache file related
tests. It's also not important to test these things, because our goal
isn't really to test the readymedia software package itself. WDYT?

You don't have to provide a v8 patch. I'll make the change myself. I'd
just like the green light from you.

Thanks,
Arun




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v7] services: Add readymedia-service-type.
  2024-10-15 20:36   ` Arun Isaac
@ 2024-10-15 20:42     ` Fabio Natali via Guix-patches via
  2024-10-18  1:19       ` [bug#72398] [PATCH] " Arun Isaac
  0 siblings, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-10-15 20:42 UTC (permalink / raw)
  To: Arun Isaac, 72398; +Cc: ludo, mirai

On 2024-10-15, 21:36 +0100, Arun Isaac <arunisaac@systemreboot.net> wrote:
> I found that the cache file related tests passed when increasing the
> sleep time.

Ha! Good catch. I should have thought of that.

> You don't have to provide a v8 patch. I'll make the change myself. I'd
> just like the green light from you.

Yep, sounds good to me! Thanks!

Cheers, F.


-- 
Fabio Natali
https://fabionatali.com




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-10-15 20:42     ` Fabio Natali via Guix-patches via
@ 2024-10-18  1:19       ` Arun Isaac
  2024-10-18 17:50         ` Fabio Natali via Guix-patches via
  0 siblings, 1 reply; 29+ messages in thread
From: Arun Isaac @ 2024-10-18  1:19 UTC (permalink / raw)
  To: 72398; +Cc: Ludovic Courtès, Bruno Victal, Fabio Natali


Hi Fabio,

I am sending you a final updated patch v8. I have modified the
indentation of the code, removed single-letter variable names, reduced
the number of variables, etc. I believe everything works. But, if you
could try it out and confirm, I'll push it.

Thanks!
Arun




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH v8] services: Add readymedia-service-type.
  2024-07-31 10:27 [bug#72398] [PATCH] services: Add readymedia-service-type Fabio Natali via Guix-patches via
                   ` (2 preceding siblings ...)
  2024-10-15 15:31 ` [bug#72398] [PATCH v7] " Fabio Natali via Guix-patches via
@ 2024-10-18  1:19 ` Arun Isaac
  3 siblings, 0 replies; 29+ messages in thread
From: Arun Isaac @ 2024-10-18  1:19 UTC (permalink / raw)
  To: 72398
  Cc: Arun Isaac, Fabio Natali, Fabio Natali, Arun Isaac, Bruno Victal,
	Ludovic Courtès, Maxim Cournoyer

From: Fabio Natali <me@fabionatali.com>

* 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: I6a3c9db9e7504df308038343ed48e4409a323581
Signed-off-by: Arun Isaac <arunisaac@systemreboot.net>
---
 doc/guix.texi         | 101 ++++++++++++++++++++
 gnu/local.mk          |   2 +
 gnu/services/upnp.scm | 208 ++++++++++++++++++++++++++++++++++++++++++
 gnu/tests/upnp.scm    | 155 +++++++++++++++++++++++++++++++
 4 files changed, 466 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 b91d229d7c..b9f71527a3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41774,6 +41774,107 @@ 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
+@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
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 29d76e7bce..81031c9bdd 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -756,6 +756,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				\
@@ -846,6 +847,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..27cbcbaa28
--- /dev/null
+++ b/gnu/services/upnp.scm
@@ -0,0 +1,208 @@
+;;; 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 (lambda (x)
+                          (match (pk x)
+                            ((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)
+                                   (writable? #f)))
+                                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.")))
diff --git a/gnu/tests/upnp.scm b/gnu/tests/upnp.scm
new file mode 100644
index 0000000000..e4bce30d89
--- /dev/null
+++ b/gnu/tests/upnp.scm
@@ -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))))

base-commit: d95588242c605fbb72e25fe36a0903a1538e9018
-- 
2.45.2





^ permalink raw reply related	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-10-18  1:19       ` [bug#72398] [PATCH] " Arun Isaac
@ 2024-10-18 17:50         ` Fabio Natali via Guix-patches via
  2024-10-18 19:02           ` Fabio Natali via Guix-patches via
  2024-10-18 20:08           ` bug#72398: " Arun Isaac
  0 siblings, 2 replies; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-10-18 17:50 UTC (permalink / raw)
  To: Arun Isaac; +Cc: Ludovic Courtès, Bruno Victal, 72398

On 2024-10-18, 02:19 +0100, Arun Isaac <arunisaac@systemreboot.net> wrote:
> I am sending you a final updated patch v8. I have modified the
> indentation of the code, removed single-letter variable names, reduced
> the number of variables, etc. I believe everything works. But, if you
> could try it out and confirm, I'll push it.

Hey Arun,

Thanks and sorry, this might have taken quite a bit of your time, it's a
non-trivial clean-up.

I've checked all the changes and rerun an end-to-end test in a VM.
Everything looks good - we're good to go! :)

Thanks for the introduction of '@acronym{}' in the docs and 'match',
'match-lambda', and 'match-record' in the code, which simplify things
quite a bit. Thanks for some stylistic improvements here and there.

Perhaps the only change I'd do at this point is around one or two
overflowing lines, personally I'd truncate them down to fit the 80-char
limit. Not a big deal and I'm also happy with v8 as it is.

Given all the help given, have you considered adding your name to the
file header?

Thanks, cheers, Fabio.


-- 
Fabio Natali
https://fabionatali.com




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-10-18 17:50         ` Fabio Natali via Guix-patches via
@ 2024-10-18 19:02           ` Fabio Natali via Guix-patches via
  2024-10-18 20:04             ` Arun Isaac
  2024-10-18 20:08           ` bug#72398: " Arun Isaac
  1 sibling, 1 reply; 29+ messages in thread
From: Fabio Natali via Guix-patches via @ 2024-10-18 19:02 UTC (permalink / raw)
  To: Arun Isaac; +Cc: Ludovic Courtès, Bruno Victal, 72398

On 2024-10-18, 18:50 +0100, Fabio Natali <me@fabionatali.com> wrote:
> Perhaps the only change I'd do at this point is around one or two
> overflowing lines, personally I'd truncate them down to fit the 80-char
> limit. Not a big deal and I'm also happy with v8 as it is.

Also, probably just a minor thing, but perhaps we might remove '(pk x)'
and make it just 'x'? Unless it's useful for logging purposes when
restarting the service? Cheers, Fabio.


-- 
Fabio Natali
https://fabionatali.com




^ permalink raw reply	[flat|nested] 29+ messages in thread

* [bug#72398] [PATCH] services: Add readymedia-service-type.
  2024-10-18 19:02           ` Fabio Natali via Guix-patches via
@ 2024-10-18 20:04             ` Arun Isaac
  0 siblings, 0 replies; 29+ messages in thread
From: Arun Isaac @ 2024-10-18 20:04 UTC (permalink / raw)
  To: Fabio Natali; +Cc: Ludovic Courtès, Bruno Victal, 72398


> Also, probably just a minor thing, but perhaps we might remove '(pk x)'
> and make it just 'x'? Unless it's useful for logging purposes when
> restarting the service? Cheers, Fabio.

Ah, good catch! That was a debugging thing I put in but forgot to
remove. Fixed now, thanks!




^ permalink raw reply	[flat|nested] 29+ messages in thread

* bug#72398: [PATCH] services: Add readymedia-service-type.
  2024-10-18 17:50         ` Fabio Natali via Guix-patches via
  2024-10-18 19:02           ` Fabio Natali via Guix-patches via
@ 2024-10-18 20:08           ` Arun Isaac
  1 sibling, 0 replies; 29+ messages in thread
From: Arun Isaac @ 2024-10-18 20:08 UTC (permalink / raw)
  To: Fabio Natali; +Cc: Ludovic Courtès, Bruno Victal, 72398-done


Hi Fabio,

Thanks for looking through all the changes. I appreciate that very much!
:-) I have pushed the patch now.

> Perhaps the only change I'd do at this point is around one or two
> overflowing lines, personally I'd truncate them down to fit the 80-char
> limit. Not a big deal and I'm also happy with v8 as it is.

I fixed one of the overflowing lines, but there's still one sticking out
slightly. I reckon it's ok, and it's more important that function
arguments line up correctly.

(list foo
      bar)

instead of

(list
  foo
  bar)

> Given all the help given, have you considered adding your name to the
> file header?

Ah, no worries! This is quite a standard review, really.

Regards,
Arun




^ permalink raw reply	[flat|nested] 29+ messages in thread

end of thread, other threads:[~2024-10-18 20:09 UTC | newest]

Thread overview: 29+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-07-31 10:27 [bug#72398] [PATCH] services: Add readymedia-service-type Fabio Natali via Guix-patches via
2024-08-12 23:19 ` Arun Isaac
2024-08-19  0:27   ` Fabio Natali via Guix-patches via
2024-08-20  2:14     ` [bug#72398] [PATCH v2] " Bruno Victal
2024-08-22 10:13       ` Fabio Natali via Guix-patches via
2024-08-22 23:28         ` Arun Isaac
2024-08-23 11:04           ` [bug#72398] [PATCH v4] " Fabio Natali via Guix-patches via
2024-08-23 15:35             ` Bruno Victal
2024-08-26 10:11               ` [bug#72398] [PATCH v5] " Fabio Natali via Guix-patches via
2024-09-06 22:17                 ` Ludovic Courtès
2024-09-08 20:04                   ` [bug#72398] [PATCH v6] " Fabio Natali via Guix-patches via
2024-10-13 17:34                     ` Fabio Natali via Guix-patches via
2024-10-13 22:57                       ` Arun Isaac
2024-10-14 21:57                         ` [bug#72398] [PATCH] " Arun Isaac
2024-10-15 15:42                           ` Fabio Natali via Guix-patches via
2024-08-23 15:25           ` [bug#72398] [PATCH v2] " Bruno Victal
2024-08-28 22:51             ` Arun Isaac
2024-08-29 14:37               ` Fabio Natali via Guix-patches via
2024-08-22 23:22       ` Arun Isaac
2024-08-22 10:17 ` [bug#72398] [PATCH v3] " Fabio Natali via Guix-patches via
2024-10-15 15:31 ` [bug#72398] [PATCH v7] " Fabio Natali via Guix-patches via
2024-10-15 20:36   ` Arun Isaac
2024-10-15 20:42     ` Fabio Natali via Guix-patches via
2024-10-18  1:19       ` [bug#72398] [PATCH] " Arun Isaac
2024-10-18 17:50         ` Fabio Natali via Guix-patches via
2024-10-18 19:02           ` Fabio Natali via Guix-patches via
2024-10-18 20:04             ` Arun Isaac
2024-10-18 20:08           ` bug#72398: " Arun Isaac
2024-10-18  1:19 ` [bug#72398] [PATCH v8] " Arun Isaac

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).