gnu/services/databases.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
   3 ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   4 ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
   5 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
   6 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
   7 ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
   8 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
   9 ;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
  10 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
  11 ;;;
  12 ;;; This file is part of GNU Guix.
  13 ;;;
  14 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  15 ;;; under the terms of the GNU General Public License as published by
  16 ;;; the Free Software Foundation; either version 3 of the License, or (at
  17 ;;; your option) any later version.
  18 ;;;
  19 ;;; GNU Guix is distributed in the hope that it will be useful, but
  20 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;;; GNU General Public License for more details.
  23 ;;;
  24 ;;; You should have received a copy of the GNU General Public License
  25 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 (define-module (gnu services databases)
  28   #:use-module (gnu services)
  29   #:use-module (gnu services shepherd)
  30   #:use-module (gnu system shadow)
  31   #:use-module (gnu packages admin)
  32   #:use-module (gnu packages databases)
  33   #:use-module (guix build-system trivial)
  34   #:use-module (guix build union)
  35   #:use-module (guix deprecation)
  36   #:use-module (guix modules)
  37   #:use-module (guix packages)
  38   #:use-module (guix records)
  39   #:use-module (guix gexp)
  40   #:use-module (srfi srfi-1)
  41   #:use-module (ice-9 match)
  42   #:export (postgresql-config-file
  43             postgresql-config-file?
  44             postgresql-config-file-log-destination
  45             postgresql-config-file-hba-file
  46             postgresql-config-file-ident-file
  47             postgresql-config-file-socket-directory
  48             postgresql-config-file-extra-config
  49
  50             postgresql-configuration
  51             postgresql-configuration?
  52             postgresql-configuration-postgresql
  53             postgresql-configuration-port
  54             postgresql-configuration-locale
  55             postgresql-configuration-file
  56             postgresql-configuration-log-directory
  57             postgresql-configuration-data-directory
  58
  59             postgresql-service
  60             postgresql-service-type
  61
  62             postgresql-role
  63             postgresql-role?
  64             postgresql-role-name
  65             postgresql-role-permissions
  66             postgresql-role-create-database?
  67             postgresql-role-configuration
  68             postgresql-role-configuration?
  69             postgresql-role-configuration-host
  70             postgresql-role-configuration-roles
  71
  72             postgresql-role-service-type
  73
  74             memcached-service-type
  75             memcached-configuration
  76             memcached-configuration?
  77             memcached-configuration-memecached
  78             memcached-configuration-interfaces
  79             memcached-configuration-tcp-port
  80             memcached-configuration-udp-port
  81             memcached-configuration-additional-options
  82
  83             mysql-service
  84             mysql-service-type
  85             mysql-configuration
  86             mysql-configuration?
  87
  88             redis-configuration
  89             redis-configuration?
  90             redis-service-type))
  91
  92 ;;; Commentary:
  93 ;;;
  94 ;;; Database services.
  95 ;;;
  96 ;;; Code:
  97
  98 (define %default-postgres-hba
  99   (plain-file "pg_hba.conf"
 100               "
 101 local   all     all                     peer
 102 host    all     all     127.0.0.1/32    md5
 103 host    all     all     ::1/128         md5"))
 104
 105 (define %default-postgres-ident
 106   (plain-file "pg_ident.conf"
 107               "# MAPNAME       SYSTEM-USERNAME         PG-USERNAME"))
 108
 109 (define-record-type* <postgresql-config-file>
 110   postgresql-config-file make-postgresql-config-file
 111   postgresql-config-file?
 112   (log-destination   postgresql-config-file-log-destination
 113                      (default "syslog"))
 114   (hba-file          postgresql-config-file-hba-file
 115                      (default %default-postgres-hba))
 116   (ident-file        postgresql-config-file-ident-file
 117                      (default %default-postgres-ident))
 118   (socket-directory  postgresql-config-file-socket-directory
 119                      (default #false))
 120   (extra-config      postgresql-config-file-extra-config
 121                      (default '())))
 122
 123 (define-gexp-compiler (postgresql-config-file-compiler
 124                        (file <postgresql-config-file>) system target)
 125   (match file
 126     (($ <postgresql-config-file> log-destination hba-file
 127                                  ident-file socket-directory
 128                                  extra-config)
 129      ;; See: https://www.postgresql.org/docs/current/config-setting.html.
 130     (define (format-value value)
 131       (cond
 132        ((boolean? value)
 133         (list (if value "on" "off")))
 134        ((number? value)
 135         (list (number->string value)))
 136        (else
 137         (list "'" value "'"))))
 138
 139     (define contents
 140       (append-map
 141        (match-lambda
 142          ((key) '())
 143          ((key . #f) '())
 144          ((key values ...)
 145           `(,key " = " ,@(append-map format-value values) "\n")))
 146
 147        `(("log_destination" ,log-destination)
 148          ("hba_file" ,hba-file)
 149          ("ident_file" ,ident-file)
 150          ,@(if socket-directory
 151                `(("unix_socket_directories" ,socket-directory))
 152                '())
 153          ,@extra-config)))
 154
 155      (gexp->derivation
 156       "postgresql.conf"
 157       #~(call-with-output-file (ungexp output "out")
 158           (lambda (port)
 159             (display
 160              (string-append #$@contents)
 161              port)))
 162       #:local-build? #t))))
 163
 164 (define-record-type* <postgresql-configuration>
 165   postgresql-configuration make-postgresql-configuration
 166   postgresql-configuration?
 167   (postgresql         postgresql-configuration-postgresql) ;<package>
 168   (port               postgresql-configuration-port
 169                       (default 5432))
 170   (locale             postgresql-configuration-locale
 171                       (default "en_US.utf8"))
 172   (config-file        postgresql-configuration-file
 173                       (default (postgresql-config-file)))
 174   (log-directory      postgresql-configuration-log-directory
 175                       (default "/var/log/postgresql"))
 176   (data-directory     postgresql-configuration-data-directory
 177                       (default "/var/lib/postgresql/data"))
 178   (extension-packages postgresql-configuration-extension-packages
 179                       (default '())))
 180
 181 (define %postgresql-accounts
 182   (list (user-group (name "postgres") (system? #t))
 183         (user-account
 184          (name "postgres")
 185          (group "postgres")
 186          (system? #t)
 187          (comment "PostgreSQL server user")
 188          (home-directory "/var/empty")
 189          (shell (file-append shadow "/sbin/nologin")))))
 190
 191 (define (final-postgresql postgresql extension-packages)
 192   (if (null? extension-packages)
 193     postgresql
 194     (package
 195       (inherit postgresql)
 196       (source #f)
 197       (build-system trivial-build-system)
 198       (arguments
 199        `(#:modules ((guix build utils) (guix build union))
 200          #:builder
 201          (begin
 202            (use-modules (guix build utils) (guix build union) (srfi srfi-26))
 203            (union-build (assoc-ref %outputs "out")
 204                         (map (lambda (input) (cdr input))
 205                              %build-inputs))
 206            #t)))
 207       (inputs
 208        `(("postgresql" ,postgresql)
 209          ,@(map (lambda (extension) (list "extension" extension))
 210                 extension-packages))))))
 211
 212 (define postgresql-activation
 213   (match-lambda
 214     (($ <postgresql-configuration> postgresql port locale config-file
 215                                    log-directory data-directory
 216                                    extension-packages)
 217      #~(begin
 218          (use-modules (guix build utils)
 219                       (ice-9 match))
 220
 221          (let ((user (getpwnam "postgres"))
 222                (initdb (string-append
 223                         #$(final-postgresql postgresql
 224                                             extension-packages)
 225                         "/bin/initdb"))
 226                (initdb-args
 227                 (append
 228                  (if #$locale
 229                      (list (string-append "--locale=" #$locale))
 230                      '()))))
 231            ;; Create db state directory.
 232            (mkdir-p #$data-directory)
 233            (chown #$data-directory (passwd:uid user) (passwd:gid user))
 234
 235            ;; Create the socket directory.
 236            (let ((socket-directory
 237                   #$(postgresql-config-file-socket-directory config-file)))
 238              (when (string? socket-directory)
 239                (mkdir-p socket-directory)
 240                (chown socket-directory (passwd:uid user) (passwd:gid user))))
 241
 242            ;; Create the log directory.
 243            (when (string? #$log-directory)
 244              (mkdir-p #$log-directory)
 245              (chown #$log-directory (passwd:uid user) (passwd:gid user)))
 246
 247            ;; Drop privileges and init state directory in a new
 248            ;; process.  Wait for it to finish before proceeding.
 249            (match (primitive-fork)
 250              (0
 251               ;; Exit with a non-zero status code if an exception is thrown.
 252               (dynamic-wind
 253                 (const #t)
 254                 (lambda ()
 255                   (setgid (passwd:gid user))
 256                   (setuid (passwd:uid user))
 257                   (primitive-exit
 258                    (apply system*
 259                           initdb
 260                           "-D"
 261                           #$data-directory
 262                           initdb-args)))
 263                 (lambda ()
 264                   (primitive-exit 1))))
 265              (pid (waitpid pid))))))))
 266
 267 (define postgresql-shepherd-service
 268   (match-lambda
 269     (($ <postgresql-configuration> postgresql port locale config-file
 270                                    log-directory data-directory
 271                                    extension-packages)
 272      (let* ((pg_ctl-wrapper
 273              ;; Wrapper script that switches to the 'postgres' user before
 274              ;; launching daemon.
 275              (program-file
 276               "pg_ctl-wrapper"
 277               #~(begin
 278                   (use-modules (ice-9 match)
 279                                (ice-9 format))
 280                   (match (command-line)
 281                     ((_ mode)
 282                      (let ((user (getpwnam "postgres"))
 283                            (pg_ctl #$(file-append
 284                                       (final-postgresql postgresql
 285                                                         extension-packages)
 286                                                   "/bin/pg_ctl"))
 287                            (options (format #f "--config-file=~a -p ~d"
 288                                             #$config-file #$port)))
 289                        (setgid (passwd:gid user))
 290                        (setuid (passwd:uid user))
 291                        (execl pg_ctl pg_ctl "-D" #$data-directory
 292                               #$@(if (string? log-directory)
 293                                      (list "-l"
 294                                            (string-append log-directory
 295                                                           "/pg_ctl.log"))
 296                                      '())
 297                               "-o" options
 298                               mode)))))))
 299             (pid-file (in-vicinity data-directory "postmaster.pid"))
 300             (action (lambda args
 301                       #~(lambda _
 302                           (invoke #$pg_ctl-wrapper #$@args)
 303                           (match '#$args
 304                             (("start")
 305                              (call-with-input-file #$pid-file read))
 306                             (_ #t))))))
 307        (list (shepherd-service
 308               (provision '(postgres))
 309               (documentation "Run the PostgreSQL daemon.")
 310               (requirement '(user-processes loopback syslogd))
 311               (modules `((ice-9 match)
 312                          ,@%default-modules))
 313               (start (action "start"))
 314               (stop (action "stop"))))))))
 315
 316 (define postgresql-service-type
 317   (service-type
 318    (name 'postgresql)
 319    (extensions
 320     (list (service-extension shepherd-root-service-type
 321                              postgresql-shepherd-service)
 322           (service-extension activation-service-type
 323                              postgresql-activation)
 324           (service-extension account-service-type
 325                              (const %postgresql-accounts))
 326           (service-extension
 327            profile-service-type
 328            (compose list postgresql-configuration-postgresql))))
 329    (default-value (postgresql-configuration
 330                    (postgresql postgresql-10)))))
 331
 332 (define-deprecated (postgresql-service #:key (postgresql postgresql)
 333                                        (port 5432)
 334                                        (locale "en_US.utf8")
 335                                        (config-file (postgresql-config-file))
 336                                        (data-directory
 337                                         "/var/lib/postgresql/data")
 338                                        (extension-packages '()))
 339   postgresql-service-type
 340   "Return a service that runs @var{postgresql}, the PostgreSQL database
 341 server.
 342
 343 The PostgreSQL daemon loads its runtime configuration from @var{config-file}
 344 and stores the database cluster in @var{data-directory}."
 345   (service postgresql-service-type
 346            (postgresql-configuration
 347             (postgresql postgresql)
 348             (port port)
 349             (locale locale)
 350             (config-file config-file)
 351             (data-directory data-directory)
 352             (extension-packages extension-packages))))
 353
 354 (define-record-type* <postgresql-role>
 355   postgresql-role make-postgresql-role
 356   postgresql-role?
 357   (name             postgresql-role-name) ;string
 358   (permissions      postgresql-role-permissions
 359                     (default '(createdb login))) ;list
 360   (create-database? postgresql-role-create-database?  ;boolean
 361                     (default #f)))
 362
 363 (define-record-type* <postgresql-role-configuration>
 364   postgresql-role-configuration make-postgresql-role-configuration
 365   postgresql-role-configuration?
 366   (host             postgresql-role-configuration-host ;string
 367                     (default "/var/run/postgresql"))
 368   (log              postgresql-role-configuration-log ;string
 369                     (default "/var/log/postgresql_roles.log"))
 370   (roles            postgresql-role-configuration-roles
 371                     (default '()))) ;list
 372
 373 (define (postgresql-create-roles config)
 374   ;; See: https://www.postgresql.org/docs/current/sql-createrole.html for the
 375   ;; complete permissions list.
 376   (define (format-permissions permissions)
 377     (let ((dict '(bypassrls createdb createrole login replication superuser)))
 378       (string-join (filter-map (lambda (permission)
 379                                  (and (member permission dict)
 380                                       (string-upcase
 381                                        (symbol->string permission))))
 382                                permissions)
 383                    " ")))
 384
 385   (define (roles->queries roles)
 386     (apply mixed-text-file "queries"
 387            (append-map
 388             (lambda (role)
 389               (match-record role <postgresql-role>
 390                 (name permissions create-database?)
 391                 `("SELECT NOT(EXISTS(SELECT 1 FROM pg_catalog.pg_roles WHERE \
 392 rolname = '" ,name "')) as not_exists;\n"
 393 "\\gset\n"
 394 "\\if :not_exists\n"
 395 "CREATE ROLE \"" ,name "\""
 396 " WITH " ,(format-permissions permissions)
 397 ";\n"
 398 ,@(if create-database?
 399       `("CREATE DATABASE \"" ,name "\""
 400         " OWNER \"" ,name "\";\n")
 401       '())
 402 "\\endif\n")))
 403             roles)))
 404
 405   (let ((host (postgresql-role-configuration-host config))
 406         (roles (postgresql-role-configuration-roles config)))
 407     #~(let ((psql #$(file-append postgresql "/bin/psql")))
 408         (list psql "-a" "-h" #$host "-f" #$(roles->queries roles)))))
 409
 410 (define (postgresql-role-shepherd-service config)
 411   (match-record config <postgresql-role-configuration>
 412     (log)
 413     (list (shepherd-service
 414            (requirement '(postgres))
 415            (provision '(postgres-roles))
 416            (one-shot? #t)
 417            (start
 418             #~(lambda args
 419                 (let ((pid (fork+exec-command
 420                             #$(postgresql-create-roles config)
 421                             #:user "postgres"
 422                             #:group "postgres"
 423                             #:log-file #$log)))
 424                   (zero? (cdr (waitpid pid))))))
 425            (documentation "Create PostgreSQL roles.")))))
 426
 427 (define postgresql-role-service-type
 428   (service-type (name 'postgresql-role)
 429                 (extensions
 430                  (list (service-extension shepherd-root-service-type
 431                                           postgresql-role-shepherd-service)))
 432                 (compose concatenate)
 433                 (extend (lambda (config extended-roles)
 434                           (match-record config <postgresql-role-configuration>
 435                             (host roles)
 436                             (postgresql-role-configuration
 437                              (host host)
 438                              (roles (append roles extended-roles))))))
 439                 (default-value (postgresql-role-configuration))
 440                 (description "Ensure the specified PostgreSQL roles are
 441 created after the PostgreSQL database is started.")))
 442
 443 \f
 444 ;;;
 445 ;;; Memcached
 446 ;;;
 447
 448 (define-record-type* <memcached-configuration>
 449   memcached-configuration make-memcached-configuration
 450   memcached-configuration?
 451   (memcached          memcached-configuration-memcached ;<package>
 452                       (default memcached))
 453   (interfaces         memcached-configuration-interfaces
 454                       (default '("0.0.0.0")))
 455   (tcp-port           memcached-configuration-tcp-port
 456                       (default 11211))
 457   (udp-port           memcached-configuration-udp-port
 458                       (default 11211))
 459   (additional-options memcached-configuration-additional-options
 460                       (default '())))
 461
 462 (define %memcached-accounts
 463   (list (user-group (name "memcached") (system? #t))
 464         (user-account
 465          (name "memcached")
 466          (group "memcached")
 467          (system? #t)
 468          (comment "Memcached server user")
 469          (home-directory "/var/empty")
 470          (shell (file-append shadow "/sbin/nologin")))))
 471
 472 (define memcached-activation
 473   #~(begin
 474       (use-modules (guix build utils))
 475       (let ((user (getpwnam "memcached")))
 476         (mkdir-p "/var/run/memcached")
 477         (chown "/var/run/memcached"
 478                (passwd:uid user) (passwd:gid user)))))
 479
 480 (define memcached-shepherd-service
 481   (match-lambda
 482     (($ <memcached-configuration> memcached interfaces tcp-port udp-port
 483                                   additional-options)
 484      (with-imported-modules (source-module-closure
 485                              '((gnu build shepherd)))
 486        (list (shepherd-service
 487               (provision '(memcached))
 488               (documentation "Run the Memcached daemon.")
 489               (requirement '(user-processes loopback))
 490               (modules '((gnu build shepherd)))
 491               (start #~(make-forkexec-constructor
 492                         `(#$(file-append memcached "/bin/memcached")
 493                           "-l" #$(string-join interfaces ",")
 494                           "-p" #$(number->string tcp-port)
 495                           "-U" #$(number->string udp-port)
 496                           "--daemon"
 497                           ;; Memcached changes to the memcached user prior to
 498                           ;; writing the pid file, so write it to a directory
 499                           ;; that memcached owns.
 500                           "-P" "/var/run/memcached/pid"
 501                           "-u" "memcached"
 502                           ,#$@additional-options)
 503                         #:log-file "/var/log/memcached"
 504                         #:pid-file "/var/run/memcached/pid"))
 505               (stop #~(make-kill-destructor))))))))
 506
 507 (define memcached-service-type
 508   (service-type (name 'memcached)
 509                 (extensions
 510                  (list (service-extension shepherd-root-service-type
 511                                           memcached-shepherd-service)
 512                        (service-extension activation-service-type
 513                                           (const memcached-activation))
 514                        (service-extension account-service-type
 515                                           (const %memcached-accounts))))
 516                 (default-value (memcached-configuration))))
 517
 518 \f
 519 ;;;
 520 ;;; MySQL.
 521 ;;;
 522
 523 (define-record-type* <mysql-configuration>
 524   mysql-configuration make-mysql-configuration
 525   mysql-configuration?
 526   (mysql mysql-configuration-mysql (default mariadb))
 527   (bind-address mysql-configuration-bind-address (default "127.0.0.1"))
 528   (port mysql-configuration-port (default 3306))
 529   (socket mysql-configuration-socket (default "/run/mysqld/mysqld.sock"))
 530   (extra-content mysql-configuration-extra-content (default ""))
 531   (extra-environment mysql-configuration-extra-environment (default #~'()))
 532   (auto-upgrade? mysql-configuration-auto-upgrade? (default #t)))
 533
 534 (define %mysql-accounts
 535   (list (user-group
 536          (name "mysql")
 537          (system? #t))
 538         (user-account
 539          (name "mysql")
 540          (group "mysql")
 541          (system? #t)
 542          (home-directory "/var/empty")
 543          (shell (file-append shadow "/sbin/nologin")))))
 544
 545 (define mysql-configuration-file
 546   (match-lambda
 547     (($ <mysql-configuration> mysql bind-address port socket extra-content)
 548      (mixed-text-file "my.cnf" "[mysqld]
 549 datadir=/var/lib/mysql
 550 socket=" socket "
 551 bind-address=" bind-address "
 552 port=" (number->string port) "
 553 " extra-content "
 554 "))))
 555
 556 (define (%mysql-activation config)
 557   "Return an activation gexp for the MySQL or MariaDB database server."
 558   (let ((mysql  (mysql-configuration-mysql config))
 559         (my.cnf (mysql-configuration-file config)))
 560     #~(begin
 561         (use-modules (ice-9 popen)
 562                      (guix build utils))
 563         (let* ((mysqld  (string-append #$mysql "/bin/mysqld"))
 564                (user    (getpwnam "mysql"))
 565                (uid     (passwd:uid user))
 566                (gid     (passwd:gid user))
 567                (datadir "/var/lib/mysql")
 568                (rundir  "/run/mysqld"))
 569           (mkdir-p datadir)
 570           (chown datadir uid gid)
 571           (mkdir-p rundir)
 572           (chown rundir uid gid)
 573           ;; Initialize the database when it doesn't exist.
 574           (when (not (file-exists? (string-append datadir "/mysql")))
 575             (if (string-prefix? "mysql-" (strip-store-file-name #$mysql))
 576                 ;; For MySQL.
 577                 (system* mysqld
 578                          (string-append "--defaults-file=" #$my.cnf)
 579                          "--initialize"
 580                          "--user=mysql")
 581                 ;; For MariaDB.
 582                 ;; XXX: The 'mysql_install_db' script doesn't work directly
 583                 ;;      due to missing 'mkdir' in PATH.
 584                 (let ((p (open-pipe* OPEN_WRITE mysqld
 585                                      (string-append
 586                                       "--defaults-file=" #$my.cnf)
 587                                      "--bootstrap"
 588                                      "--user=mysql")))
 589                   ;; Create the system database, as does by 'mysql_install_db'.
 590                   (display "create database mysql;\n" p)
 591                   (display "use mysql;\n" p)
 592                   (for-each
 593                    (lambda (sql)
 594                      (call-with-input-file
 595                          (string-append #$mysql:lib "/share/mysql/" sql)
 596                        (lambda (in) (dump-port in p))))
 597                    '("mysql_system_tables.sql"
 598                      "mysql_performance_tables.sql"
 599                      "mysql_system_tables_data.sql"
 600                      "fill_help_tables.sql"))
 601                   ;; Remove the anonymous user and disable root access from
 602                   ;; remote machines, as does by 'mysql_secure_installation'.
 603                   (display "
 604 DELETE FROM user WHERE User='';
 605 DELETE FROM user WHERE User='root' AND
 606   Host NOT IN  ('localhost', '127.0.0.1', '::1');
 607 FLUSH PRIVILEGES;
 608 " p)
 609                   (close-pipe p))))))))
 610
 611 (define (mysql-shepherd-service config)
 612   (list (shepherd-service
 613          (provision '(mysql))
 614          (documentation "Run the MySQL server.")
 615          (start (let ((mysql  (mysql-configuration-mysql config))
 616                       (extra-env (mysql-configuration-extra-environment config))
 617                       (my.cnf (mysql-configuration-file config)))
 618                   #~(make-forkexec-constructor
 619                      (list (string-append #$mysql "/bin/mysqld")
 620                            (string-append "--defaults-file=" #$my.cnf))
 621                            #:user "mysql" #:group "mysql"
 622                            #:log-file "/var/log/mysqld.log"
 623                            #:environment-variables #$extra-env)))
 624          (stop #~(make-kill-destructor)))))
 625
 626 (define (mysql-upgrade-wrapper mysql socket-file)
 627   ;; The MySQL socket and PID file may appear before the server is ready to
 628   ;; accept connections.  Ensure the socket is responsive before attempting
 629   ;; to run the upgrade script.
 630   (program-file
 631    "mysql-upgrade-wrapper"
 632    #~(begin
 633        (let ((mysql-upgrade #$(file-append mysql "/bin/mysql_upgrade"))
 634              (timeout 10))
 635          (begin
 636            (let loop ((i 0))
 637              (catch 'system-error
 638                (lambda ()
 639                  (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
 640                    (connect sock AF_UNIX #$socket-file)
 641                    (close-port sock)
 642                    ;; The socket is ready!
 643                    (execl mysql-upgrade mysql-upgrade
 644                           (string-append "--socket=" #$socket-file))))
 645                (lambda args
 646                  (if (< i timeout)
 647                      (begin
 648                        (sleep 1)
 649                        (loop (+ 1 i)))
 650                      ;; No luck, give up.
 651                      (throw 'timeout-error
 652                             "MySQL server did not appear in time!"))))))))))
 653
 654 (define (mysql-upgrade-shepherd-service config)
 655   (list (shepherd-service
 656          (provision '(mysql-upgrade))
 657          (requirement '(mysql))
 658          (one-shot? #t)
 659          (documentation "Upgrade MySQL database schemas.")
 660          (start (let ((mysql (mysql-configuration-mysql config))
 661                       (socket (mysql-configuration-socket config)))
 662                   #~(make-forkexec-constructor
 663                      (list #$(mysql-upgrade-wrapper mysql socket))
 664                      #:user "mysql" #:group "mysql"))))))
 665
 666 (define (mysql-shepherd-services config)
 667   (if (mysql-configuration-auto-upgrade? config)
 668       (append (mysql-shepherd-service config)
 669               (mysql-upgrade-shepherd-service config))
 670       (mysql-shepherd-service config)))
 671
 672 (define mysql-service-type
 673   (service-type
 674    (name 'mysql)
 675    (extensions
 676     (list (service-extension account-service-type
 677                              (const %mysql-accounts))
 678           (service-extension activation-service-type
 679                              %mysql-activation)
 680           (service-extension shepherd-root-service-type
 681                              mysql-shepherd-services)))
 682    (default-value (mysql-configuration))))
 683
 684 (define-deprecated (mysql-service #:key (config (mysql-configuration)))
 685   mysql-service-type
 686   (service mysql-service-type config))
 687
 688 \f
 689 ;;;
 690 ;;; Redis
 691 ;;;
 692
 693 (define-record-type* <redis-configuration>
 694   redis-configuration make-redis-configuration
 695   redis-configuration?
 696   (redis             redis-configuration-redis ;<package>
 697                      (default redis))
 698   (bind              redis-configuration-bind
 699                      (default "127.0.0.1"))
 700   (port              redis-configuration-port
 701                      (default 6379))
 702   (working-directory redis-configuration-working-directory
 703                      (default "/var/lib/redis"))
 704   (config-file       redis-configuration-config-file
 705                      (default #f)))
 706
 707 (define (default-redis.conf bind port working-directory)
 708   (mixed-text-file "redis.conf"
 709                    "bind " bind "\n"
 710                    "port " (number->string port) "\n"
 711                    "dir " working-directory "\n"
 712                    "daemonize no\n"))
 713
 714 (define %redis-accounts
 715   (list (user-group (name "redis") (system? #t))
 716         (user-account
 717          (name "redis")
 718          (group "redis")
 719          (system? #t)
 720          (comment "Redis server user")
 721          (home-directory "/var/empty")
 722          (shell (file-append shadow "/sbin/nologin")))))
 723
 724 (define redis-activation
 725   (match-lambda
 726     (($ <redis-configuration> redis bind port working-directory config-file)
 727      #~(begin
 728          (use-modules (guix build utils)
 729                       (ice-9 match))
 730
 731          (let ((user (getpwnam "redis")))
 732            (mkdir-p #$working-directory)
 733            (chown #$working-directory (passwd:uid user) (passwd:gid user)))))))
 734
 735 (define redis-shepherd-service
 736   (match-lambda
 737     (($ <redis-configuration> redis bind port working-directory config-file)
 738      (let ((config-file
 739             (or config-file
 740                 (default-redis.conf bind port working-directory))))
 741        (list (shepherd-service
 742               (provision '(redis))
 743               (documentation "Run the Redis daemon.")
 744               (requirement '(user-processes syslogd))
 745               (start #~(make-forkexec-constructor
 746                         '(#$(file-append redis "/bin/redis-server")
 747                           #$config-file)
 748                         #:user "redis"
 749                         #:group "redis"))
 750               (stop #~(make-kill-destructor))))))))
 751
 752 (define redis-service-type
 753   (service-type (name 'redis)
 754                 (extensions
 755                  (list (service-extension shepherd-root-service-type
 756                                           redis-shepherd-service)
 757                        (service-extension activation-service-type
 758                                           redis-activation)
 759                        (service-extension account-service-type
 760                                           (const %redis-accounts))))
 761                 (default-value (redis-configuration))))