gnu/services/dict.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
   3 ;;; Copyright © 2016, 2017, 2018, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
   4 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu services dict)
  22   #:use-module (guix gexp)
  23   #:use-module (guix records)
  24   #:use-module (guix modules)
  25   #:use-module (guix least-authority)
  26   #:use-module (gnu services)
  27   #:use-module (gnu services shepherd)
  28   #:use-module (gnu system shadow)
  29   #:use-module ((gnu packages admin) #:select (shadow))
  30   #:use-module (gnu packages dico)
  31   #:use-module (gnu packages dictionaries)
  32   #:autoload   (gnu build linux-container) (%namespaces)
  33   #:autoload   (gnu system file-systems) (file-system-mapping)
  34   #:use-module (srfi srfi-1)
  35   #:use-module (srfi srfi-26)
  36   #:use-module (ice-9 match)
  37   #:export (dicod-service
  38             dicod-service-type
  39             dicod-configuration
  40             dicod-handler
  41             dicod-database
  42             %dicod-database:gcide))
  43
  44 \f
  45 ;;;
  46 ;;; GNU Dico.
  47 ;;;
  48
  49 (define-record-type* <dicod-configuration>
  50   dicod-configuration make-dicod-configuration
  51   dicod-configuration?
  52   (dico        dicod-configuration-dico       (default dico))
  53   (interfaces  dicod-configuration-interfaces     ;list of strings
  54                (default '("localhost")))
  55   (handlers    dicod-configuration-handlers       ;list of <dicod-handler>
  56                (default '()))
  57   (databases   dicod-configuration-databases      ;list of <dicod-database>
  58                (default (list %dicod-database:gcide))))
  59
  60 (define-record-type* <dicod-handler>
  61   dicod-handler make-dicod-handler
  62   dicod-handler?
  63   (name        dicod-handler-name)
  64   (module      dicod-handler-module          (default #f))
  65   (options     dicod-handler-options         (default '())))
  66
  67 (define-record-type* <dicod-database>
  68   dicod-database make-dicod-database
  69   dicod-database?
  70   (name        dicod-database-name)
  71   (handler     dicod-database-handler)
  72   (complex?    dicod-database-complex?       (default #f))
  73   (options     dicod-database-options        (default '())))
  74
  75 (define %dicod-database:gcide
  76   (dicod-database
  77    (name "gcide")
  78    (handler "gcide")
  79    (options (list #~(string-append "dbdir=" #$gcide "/share/gcide")
  80                   "idxdir=/var/run/dicod"))))
  81
  82 (define %dicod-accounts
  83   (list (user-group
  84          (name "dicod")
  85          (system? #t))
  86         (user-account
  87          (name "dicod")
  88          (group "dicod")
  89          (system? #t)
  90          (home-directory "/var/empty")
  91          (shell (file-append shadow "/sbin/nologin")))))
  92
  93 (define (dicod-configuration-file config)
  94   (define handler->text
  95     (match-lambda
  96       (($ <dicod-handler> name #f '())
  97        `("
  98 load-module " ,name ";"))
  99       (($ <dicod-handler> name #f options)
 100        (handler->text (dicod-handler
 101                        (name name)
 102                        (module name)
 103                        (options options))))
 104       (($ <dicod-handler> name module options)
 105        `("
 106 load-module " ,name " {
 107    command \"" ,module (string-join (list ,@options) " " 'prefix) "\";
 108 }\n"))))
 109
 110   (define database->text
 111     (match-lambda
 112       (($ <dicod-database> name handler #f options)
 113        (append
 114         (handler->text (dicod-handler
 115                         (name handler)))
 116         (database->text (dicod-database
 117                          (name name)
 118                          (handler handler)
 119                          (complex? #t)
 120                          (options options)))))
 121       (($ <dicod-database> name handler complex? options)
 122        `("
 123 database {
 124    name \"" ,name "\";
 125    handler \"" ,handler
 126    (string-join (list ,@options) " " 'prefix) "\";
 127 }\n"))))
 128
 129   (define configuration->text
 130     (match-lambda
 131       (($ <dicod-configuration> dico (interfaces ...) handlers databases)
 132        (append `("listen ("
 133                  ,(string-join interfaces ", ") ");\n")
 134                (append-map handler->text handlers)
 135                (append-map database->text databases)))))
 136
 137   (apply mixed-text-file "dicod.conf" (configuration->text config)))
 138
 139 (define %dicod-activation
 140   #~(begin
 141       (use-modules (guix build utils))
 142       (let ((user   (getpwnam "dicod"))
 143             (rundir "/var/run/dicod"))
 144         (mkdir-p rundir)
 145         (chown rundir (passwd:uid user) (passwd:gid user)))))
 146
 147 (define (dicod-shepherd-service config)
 148   (let* ((dicod.conf (dicod-configuration-file config))
 149          (dicod      (least-authority-wrapper
 150                       (file-append (dicod-configuration-dico config)
 151                                    "/bin/dicod")
 152                       #:name "dicod"
 153                       #:mappings (list (file-system-mapping
 154                                         (source "/var/run/dicod")
 155                                         (target source)
 156                                         (writable? #t))
 157                                        (file-system-mapping
 158                                         (source "/dev/log")
 159                                         (target source))
 160                                        (file-system-mapping
 161                                         (source dicod.conf)
 162                                         (target source)))
 163                       #:namespaces (delq 'net %namespaces))))
 164     (list (shepherd-service
 165            (provision '(dicod))
 166            (requirement '(user-processes))
 167            (documentation "Run the dicod daemon.")
 168            (start #~(make-forkexec-constructor
 169                      (list #$dicod "--foreground"
 170                            (string-append "--config=" #$dicod.conf))
 171                      #:user "dicod" #:group "dicod"))
 172            (stop #~(make-kill-destructor))))))
 173
 174 (define dicod-service-type
 175   (service-type
 176    (name 'dict)
 177    (extensions
 178     (list (service-extension account-service-type
 179                              (const %dicod-accounts))
 180           (service-extension activation-service-type
 181                              (const %dicod-activation))
 182           (service-extension shepherd-root-service-type
 183                              dicod-shepherd-service)))
 184    (default-value (dicod-configuration))
 185    (description
 186     "Run @command{dicod}, the dictionary server of
 187 @uref{https://www.gnu.org/software/dico, GNU Dico}.  @command{dicod}
 188 implements the standard DICT protocol supported by clients such as
 189 @command{dico} and GNOME Dictionary.")))
 190
 191 (define* (dicod-service #:key (config (dicod-configuration)))
 192   "Return a service that runs the @command{dicod} daemon, an implementation
 193 of DICT server (@pxref{Dicod,,, dico, GNU Dico Manual}).
 194
 195 The optional @var{config} argument specifies the configuration for
 196 @command{dicod}, which should be a @code{<dicod-configuration>} object, by
 197 default it serves the GNU Collaborative International Dictionary of English.
 198
 199 You can add @command{open localhost} to your @file{~/.dico} file to make
 200 @code{localhost} the default server for @command{dico}
 201 client (@pxref{Initialization File,,, dico, GNU Dico Manual})."
 202   (service dicod-service-type config))