;;; 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.")))