1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Files
guix/gnu/services/upnp.scm
Sughosha 2746e07180 services: readymedia: Allow relative paths to media directories.
* gnu/services/upnp.scm (readymedia-activation): For home services, if the
media directory paths are relative, create it in the user's home directory.
* doc/guix.texi (Miscellaneous Services)[DLNA/UPnP Services]: Update doc.

Change-Id: I39176320d6c33c56c5b80ad9e67e989ee41565da
2026-03-03 23:53:40 +05:30

274 lines
12 KiB
Scheme

;;; 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-file
%readymedia-default-pid-directory
%readymedia-pid-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
readymedia-activation
readymedia-shepherd-service))
;;; Commentary:
;;;
;;; UPnP services.
;;;
;;; Code:
(define* (%readymedia-default-cache-directory #:key (home-service? #f))
(if home-service?
".cache/readymedia"
"/var/cache/readymedia"))
(define* (%readymedia-default-log-file #:key (home-service? #f))
(if home-service?
#~(begin
(use-modules (shepherd support)) ;for %user-log-dir
(string-append %user-log-dir "/readymedia.log"))
"/var/log/readymedia.log"))
(define %readymedia-default-pid-directory "/var/run/readymedia")
(define* (%readymedia-pid-file #:key (home-service? #f) (name "minidlna.pid"))
(if home-service?
#~(begin
(use-modules (shepherd support)) ;for %user-runtime-dir
(string-append %user-runtime-dir "/readymedia/" #$name))
(string-append %readymedia-default-pid-directory "/" name)))
(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
#:home-service? for-home?)))
(log-file readymedia-configuration-log-directory
(default (%readymedia-default-log-file
#:home-service? for-home?)))
(friendly-name readymedia-configuration-friendly-name
(default #f))
(media-directories readymedia-configuration-media-directories)
(extra-config readymedia-configuration-extra-config
(default '()))
(home-service? readymedia-configuration-home-service?
(default for-home?) (innate)))
;; 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 media-directories extra-config
home-service?)
(apply mixed-text-file
"minidlna.conf"
"db_dir=" cache-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 "\n"))))
media-directories)
(map (match-lambda
((key . value)
(string-append key "=" value "\n")))
extra-config)))))
(define (readymedia-shepherd-service config)
"Return a least-authority ReadyMedia/MiniDLNA Shepherd service."
(match-record config <readymedia-configuration>
(cache-directory log-file media-directories home-service?)
(let ((minidlna-conf (readymedia-configuration->config-file config)))
(shepherd-service
(documentation "Run the ReadyMedia/MiniDLNA daemon.")
(provision '(readymedia))
(requirement (if home-service? '() '(networking user-processes)))
(modules '((shepherd support))) ;for %user-log-dir
(start
(if (not home-service?)
#~(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 %readymedia-default-pid-directory)
(target source)
(writable? #t))
(file-system-mapping
(source minidlna-conf)
(target source))
(map (lambda (directory)
(file-system-mapping
(source (readymedia-media-directory-path
directory))
(target source)))
media-directories))
#:namespaces (delq 'net %namespaces))
"-f"
#$minidlna-conf
"-P"
#$(%readymedia-pid-file)
"-S")
#:log-file #$log-file
#:user #$(if home-service? #f %readymedia-user-account)
#:group #$(if home-service? #f %readymedia-user-group))
;; Relative paths to home directories are not being able to be
;; mapped within the least-authority-wrapper. So, for home we use
;; the program without wrapping it.
#~(make-forkexec-constructor
(list #$(file-append (readymedia-configuration-readymedia
config)
"/sbin/minidlnad")
"-f"
#$minidlna-conf
"-P"
#$(%readymedia-pid-file #:home-service? home-service?)
"-S")
#:log-file #$log-file)))
(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 media-directories home-service?)
(with-imported-modules (source-module-closure '((gnu build activation)))
#~(begin
(use-modules (gnu build activation))
(for-each (lambda (directory)
(let ((directory
(if #$home-service?
(if (absolute-file-name? directory)
directory
(string-append (or (getenv "HOME")
(passwd:dir
(getpwuid (getuid))))
"/" directory))
directory)))
(unless (file-exists? directory)
(mkdir-p/perms directory
(getpw #$(if home-service?
#~(getuid)
%readymedia-user-account))
#$(if home-service? #o755 #o775)))))
(list #$@(map readymedia-media-directory-path
media-directories)))
(for-each (lambda (directory)
(unless (file-exists? directory)
(mkdir-p/perms directory
(getpw #$(if home-service?
#~(getuid)
%readymedia-user-account))
#o755)))
(list (if #$home-service?
(if (absolute-file-name? #$cache-directory)
#$cache-directory
(string-append (or (getenv "HOME")
(passwd:dir
(getpwuid (getuid))))
"/" #$cache-directory))
#$cache-directory)
(dirname #$(%readymedia-pid-file
#:home-service? home-service?))))))))
(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.")))