projects/guix·blob javascript-team · refs

273 lines · 12.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2024 Fabio Natali <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19;;; Commentary:
20;;;
21;;; UPnP services.
22;;;
23;;; Code:
24
25(define-module (gnu services upnp)
26 #:use-module (gnu build linux-container)
27 #:use-module (gnu packages admin)
28 #:use-module (gnu packages upnp)
29 #:use-module (gnu services admin)
30 #:use-module (gnu services base)
31 #:use-module (gnu services shepherd)
32 #:use-module (gnu services)
33 #:use-module (gnu system file-systems)
34 #:use-module (gnu system shadow)
35 #:use-module (guix gexp)
36 #:use-module (guix least-authority)
37 #:use-module (guix modules)
38 #:use-module (guix records)
39 #:use-module (ice-9 match)
40 #:export (%readymedia-default-cache-directory
41 %readymedia-default-log-file
42 %readymedia-default-pid-directory
43 %readymedia-pid-file
44 %readymedia-user-account
45 %readymedia-user-group
46 readymedia-configuration
47 readymedia-configuration?
48 readymedia-configuration-readymedia
49 readymedia-configuration-port
50 readymedia-configuration-cache-directory
51 readymedia-configuration-extra-config
52 readymedia-configuration-friendly-name
53 readymedia-configuration-log-directory
54 readymedia-configuration-media-directories
55 readymedia-media-directory
56 readymedia-media-directory-path
57 readymedia-media-directory-types
58 readymedia-media-directory?
59 readymedia-service-type
60 readymedia-activation
61 readymedia-shepherd-service))
62
63(define* (%readymedia-default-cache-directory #:key (home-service? #f))
64 (if home-service?
65 ".cache/readymedia"
66 "/var/cache/readymedia"))
67(define* (%readymedia-default-log-file #:key (home-service? #f))
68 (if home-service?
69 #~(begin
70 (use-modules (shepherd support)) ;for %user-log-dir
71 (string-append %user-log-dir "/readymedia.log"))
72 "/var/log/readymedia.log"))
73(define %readymedia-default-pid-directory "/var/run/readymedia")
74(define* (%readymedia-pid-file #:key (home-service? #f) (name "minidlna.pid"))
75 (if home-service?
76 #~(begin
77 (use-modules (shepherd support)) ;for %user-runtime-dir
78 (string-append %user-runtime-dir "/readymedia/" #$name))
79 (string-append %readymedia-default-pid-directory "/" name)))
80(define %readymedia-user-group "readymedia")
81(define %readymedia-user-account "readymedia")
82
83(define-record-type* <readymedia-configuration>
84 readymedia-configuration make-readymedia-configuration
85 readymedia-configuration?
86 (readymedia readymedia-configuration-readymedia
87 (default readymedia))
88 (port readymedia-configuration-port
89 (default #f))
90 (cache-directory readymedia-configuration-cache-directory
91 (default (%readymedia-default-cache-directory
92 #:home-service? for-home?)))
93 (log-file readymedia-configuration-log-directory
94 (default (%readymedia-default-log-file
95 #:home-service? for-home?)))
96 (friendly-name readymedia-configuration-friendly-name
97 (default #f))
98 (media-directories readymedia-configuration-media-directories)
99 (extra-config readymedia-configuration-extra-config
100 (default '()))
101 (home-service? readymedia-configuration-home-service?
102 (default for-home?) (innate)))
103
104;; READYMEDIA-MEDIA-DIR is a record that indicates the path of a media folder
105;; and the types of media included within it. Allowed individual types are the
106;; symbols 'A' for audio, 'V' for video, and 'P' for pictures. The types field
107;; can contain any combination of individual types; an empty list means that
108;; no type is specified.
109(define-record-type* <readymedia-media-directory>
110 readymedia-media-directory make-readymedia-media-directory
111 readymedia-media-directory?
112 (path readymedia-media-directory-path)
113 (types readymedia-media-directory-types
114 (default '())))
115
116(define (readymedia-configuration->config-file config)
117 "Return the ReadyMedia/MiniDLNA configuration file corresponding to CONFIG."
118 (match-record config <readymedia-configuration>
119 (port friendly-name cache-directory media-directories extra-config
120 home-service?)
121 (apply mixed-text-file
122 "minidlna.conf"
123 "db_dir=" cache-directory "\n"
124 (if friendly-name
125 (string-append "friendly_name=" friendly-name "\n")
126 "")
127 (if port
128 (string-append "port=" (number->string port) "\n")
129 "")
130 (append (map (match-record-lambda <readymedia-media-directory>
131 (path types)
132 (apply string-append
133 "media_dir="
134 (append (map symbol->string types)
135 (match types
136 (() (list))
137 (_ (list ",")))
138 (list path "\n"))))
139 media-directories)
140 (map (match-lambda
141 ((key . value)
142 (string-append key "=" value "\n")))
143 extra-config)))))
144
145(define (readymedia-shepherd-service config)
146 "Return a least-authority ReadyMedia/MiniDLNA Shepherd service."
147 (match-record config <readymedia-configuration>
148 (cache-directory log-file media-directories home-service?)
149 (let ((minidlna-conf (readymedia-configuration->config-file config)))
150 (shepherd-service
151 (documentation "Run the ReadyMedia/MiniDLNA daemon.")
152 (provision '(readymedia))
153 (requirement (if home-service? '() '(networking user-processes)))
154 (modules '((shepherd support))) ;for %user-log-dir
155 (start
156 (if (not home-service?)
157 #~(make-forkexec-constructor
158 (list #$(least-authority-wrapper
159 (file-append (readymedia-configuration-readymedia
160 config)
161 "/sbin/minidlnad")
162 #:name "minidlna"
163 #:mappings
164 (cons* (file-system-mapping
165 (source cache-directory)
166 (target source)
167 (writable? #t))
168 (file-system-mapping
169 (source %readymedia-default-pid-directory)
170 (target source)
171 (writable? #t))
172 (file-system-mapping
173 (source minidlna-conf)
174 (target source))
175 (map (lambda (directory)
176 (file-system-mapping
177 (source (readymedia-media-directory-path
178 directory))
179 (target source)))
180 media-directories))
181 #:namespaces (delq 'net %namespaces))
182 "-f"
183 #$minidlna-conf
184 "-P"
185 #$(%readymedia-pid-file)
186 "-S")
187 #:log-file #$log-file
188 #:user #$(if home-service? #f %readymedia-user-account)
189 #:group #$(if home-service? #f %readymedia-user-group))
190
191 ;; Relative paths to home directories are not being able to be
192 ;; mapped within the least-authority-wrapper. So, for home we use
193 ;; the program without wrapping it.
194 #~(make-forkexec-constructor
195 (list #$(file-append (readymedia-configuration-readymedia
196 config)
197 "/sbin/minidlnad")
198 "-f"
199 #$minidlna-conf
200 "-P"
201 #$(%readymedia-pid-file #:home-service? home-service?)
202 "-S")
203 #:log-file #$log-file)))
204 (stop #~(make-kill-destructor))))))
205
206(define readymedia-accounts
207 (list (user-account
208 (name "readymedia")
209 (group "readymedia")
210 (system? #t)
211 (comment "ReadyMedia/MiniDLNA daemon user")
212 (home-directory "/var/empty")
213 (shell (file-append shadow "/sbin/nologin")))
214 (user-group
215 (name "readymedia")
216 (system? #t))))
217
218(define (readymedia-activation config)
219 "Set up directories for ReadyMedia/MiniDLNA."
220 (match-record config <readymedia-configuration>
221 (cache-directory media-directories home-service?)
222 (with-imported-modules (source-module-closure '((gnu build activation)))
223 #~(begin
224 (use-modules (gnu build activation))
225
226 (for-each (lambda (directory)
227 (let ((directory
228 (if #$home-service?
229 (if (absolute-file-name? directory)
230 directory
231 (string-append (or (getenv "HOME")
232 (passwd:dir
233 (getpwuid (getuid))))
234 "/" directory))
235 directory)))
236 (unless (file-exists? directory)
237 (mkdir-p/perms directory
238 (getpw #$(if home-service?
239 #~(getuid)
240 %readymedia-user-account))
241 #$(if home-service? #o755 #o775)))))
242 (list #$@(map readymedia-media-directory-path
243 media-directories)))
244 (for-each (lambda (directory)
245 (unless (file-exists? directory)
246 (mkdir-p/perms directory
247 (getpw #$(if home-service?
248 #~(getuid)
249 %readymedia-user-account))
250 #o755)))
251 (list (if #$home-service?
252 (if (absolute-file-name? #$cache-directory)
253 #$cache-directory
254 (string-append (or (getenv "HOME")
255 (passwd:dir
256 (getpwuid (getuid))))
257 "/" #$cache-directory))
258 #$cache-directory)
259 (dirname #$(%readymedia-pid-file
260 #:home-service? home-service?))))))))
261
262(define readymedia-service-type
263 (service-type
264 (name 'readymedia)
265 (extensions
266 (list (service-extension shepherd-root-service-type
267 (compose list readymedia-shepherd-service))
268 (service-extension account-service-type
269 (const readymedia-accounts))
270 (service-extension activation-service-type
271 readymedia-activation)))
272 (description
273 "Run @command{minidlnad}, the ReadyMedia/MiniDLNA media server.")))