gnu/tests/databases.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
   3 ;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu tests databases)
  21   #:use-module (gnu tests)
  22   #:use-module (gnu system)
  23   #:use-module (gnu system file-systems)
  24   #:use-module (gnu system shadow)
  25   #:use-module (gnu system vm)
  26   #:use-module (gnu services)
  27   #:use-module (gnu services databases)
  28   #:use-module (gnu services networking)
  29   #:use-module (gnu packages databases)
  30   #:use-module (guix gexp)
  31   #:use-module (guix store)
  32   #:export (%test-memcached
  33             %test-postgresql
  34             %test-mysql))
  35
  36 (define %memcached-os
  37   (simple-operating-system
  38    (service dhcp-client-service-type)
  39    (service memcached-service-type)))
  40
  41 (define* (run-memcached-test #:optional (port 11211))
  42   "Run tests in %MEMCACHED-OS, forwarding PORT."
  43   (define os
  44     (marionette-operating-system
  45      %memcached-os
  46      #:imported-modules '((gnu services herd)
  47                           (guix combinators))))
  48
  49   (define vm
  50     (virtual-machine
  51      (operating-system os)
  52      (port-forwardings `((11211 . ,port)))))
  53
  54   (define test
  55     (with-imported-modules '((gnu build marionette))
  56       #~(begin
  57           (use-modules (srfi srfi-11) (srfi srfi-64)
  58                        (gnu build marionette)
  59                        (ice-9 rdelim))
  60
  61           (define marionette
  62             (make-marionette (list #$vm)))
  63
  64           (mkdir #$output)
  65           (chdir #$output)
  66
  67           (test-begin "memcached")
  68
  69           ;; Wait for memcached to be up and running.
  70           (test-assert "service running"
  71             (marionette-eval
  72              '(begin
  73                 (use-modules (gnu services herd))
  74                 (match (start-service 'memcached)
  75                   (#f #f)
  76                   (('service response-parts ...)
  77                    (match (assq-ref response-parts 'running)
  78                      ((pid) (number? pid))))))
  79              marionette))
  80
  81           (let* ((ai (car (getaddrinfo "localhost"
  82                                        #$(number->string port))))
  83                  (s  (socket (addrinfo:fam ai)
  84                              (addrinfo:socktype ai)
  85                              (addrinfo:protocol ai)))
  86                  (key "testkey")
  87                  (value "guix"))
  88             (connect s (addrinfo:addr ai))
  89
  90             (test-equal "set"
  91               "STORED\r"
  92               (begin
  93                 (simple-format s "set ~A 0 60 ~A\r\n~A\r\n"
  94                                key
  95                                (string-length value)
  96                                value)
  97                 (read-line s)))
  98
  99             (test-equal "get"
 100               (simple-format #f "VALUE ~A 0 ~A\r~A\r"
 101                              key
 102                              (string-length value)
 103                              value)
 104               (begin
 105                 (simple-format s "get ~A\r\n" key)
 106                 (string-append
 107                  (read-line s)
 108                  (read-line s))))
 109
 110             (close-port s))
 111
 112           ;; There should be a log file in here.
 113           (test-assert "log file"
 114             (marionette-eval
 115              '(file-exists? "/var/log/memcached")
 116              marionette))
 117
 118           (test-end)
 119           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 120
 121   (gexp->derivation "memcached-test" test))
 122
 123 (define %test-memcached
 124   (system-test
 125    (name "memcached")
 126    (description "Connect to a running MEMCACHED server.")
 127    (value (run-memcached-test))))
 128
 129 \f
 130 ;;;
 131 ;;; The PostgreSQL service.
 132 ;;;
 133
 134 (define %postgresql-log-directory
 135   "/var/log/postgresql")
 136
 137 (define %role-log-file
 138   "/var/log/postgresql_roles.log")
 139
 140 (define %postgresql-os
 141   (simple-operating-system
 142    (service postgresql-service-type
 143             (postgresql-configuration
 144              (postgresql postgresql-10)
 145              (config-file
 146               (postgresql-config-file
 147                (extra-config
 148                 '(("session_preload_libraries" "auto_explain")
 149                   ("random_page_cost" 2)
 150                   ("auto_explain.log_min_duration" "100 ms")
 151                   ("work_mem" "500 MB")
 152                   ("debug_print_plan" #t)))))))
 153    (service postgresql-role-service-type
 154             (postgresql-role-configuration
 155              (roles
 156               (list (postgresql-role
 157                      (name "root")
 158                      (create-database? #t))))))))
 159
 160 (define (run-postgresql-test)
 161   "Run tests in %POSTGRESQL-OS."
 162   (define os
 163     (marionette-operating-system
 164      %postgresql-os
 165      #:imported-modules '((gnu services herd)
 166                           (guix combinators))))
 167
 168   (define vm
 169     (virtual-machine
 170      (operating-system os)
 171      (memory-size 512)))
 172
 173   (define test
 174     (with-imported-modules '((gnu build marionette))
 175       #~(begin
 176           (use-modules (srfi srfi-64)
 177                        (gnu build marionette))
 178
 179           (define marionette
 180             (make-marionette (list #$vm)))
 181
 182           (mkdir #$output)
 183           (chdir #$output)
 184
 185           (test-begin "postgresql")
 186
 187           (test-assert "service running"
 188             (marionette-eval
 189              '(begin
 190                 (use-modules (gnu services herd))
 191                 (start-service 'postgres))
 192              marionette))
 193
 194           (test-assert "log-file"
 195             (marionette-eval
 196              '(begin
 197                 (use-modules (ice-9 ftw)
 198                              (ice-9 match))
 199                 (current-output-port
 200                  (open-file "/dev/console" "w0"))
 201                 (let ((server-log-file
 202                        (string-append #$%postgresql-log-directory
 203                                       "/pg_ctl.log")))
 204                   (and (file-exists? server-log-file)
 205                        (display
 206                         (call-with-input-file server-log-file
 207                           get-string-all)))
 208                   #t))
 209              marionette))
 210
 211           (test-assert "database ready"
 212             (begin
 213               (marionette-eval
 214                '(begin
 215                   (let loop ((i 10))
 216                     (unless (or (zero? i)
 217                                 (and (file-exists? #$%role-log-file)
 218                                      (string-contains
 219                                       (call-with-input-file #$%role-log-file
 220                                         get-string-all)
 221                                       ";\nCREATE DATABASE")))
 222                       (sleep 1)
 223                       (loop (- i 1)))))
 224                marionette)))
 225
 226           (test-assert "database creation"
 227             (marionette-eval
 228              '(begin
 229                 (use-modules (gnu services herd)
 230                              (ice-9 popen))
 231                 (current-output-port
 232                  (open-file "/dev/console" "w0"))
 233                 (let* ((port (open-pipe*
 234                               OPEN_READ
 235                               #$(file-append postgresql "/bin/psql")
 236                               "-tAh" "/var/run/postgresql"
 237                               "-c" "SELECT 1 FROM pg_database WHERE
 238  datname='root'"))
 239                        (output (get-string-all port)))
 240                   (close-pipe port)
 241                   (string-contains output "1")))
 242              marionette))
 243
 244           (test-end)
 245           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 246
 247   (gexp->derivation "postgresql-test" test))
 248
 249 (define %test-postgresql
 250   (system-test
 251    (name "postgresql")
 252    (description "Start the PostgreSQL service.")
 253    (value (run-postgresql-test))))
 254
 255 \f
 256 ;;;
 257 ;;; The MySQL service.
 258 ;;;
 259
 260 (define %mysql-os
 261   (simple-operating-system
 262    (service mysql-service-type)))
 263
 264 (define* (run-mysql-test)
 265   "Run tests in %MYSQL-OS."
 266   (define os
 267     (marionette-operating-system
 268      %mysql-os
 269      #:imported-modules '((gnu services herd)
 270                           (guix combinators))))
 271
 272   (define vm
 273     (virtual-machine
 274      (operating-system os)
 275      (memory-size 512)))
 276
 277   (define test
 278     (with-imported-modules '((gnu build marionette))
 279       #~(begin
 280           (use-modules (srfi srfi-11) (srfi srfi-64)
 281                        (gnu build marionette))
 282
 283           (define marionette
 284             (make-marionette (list #$vm)))
 285
 286           (mkdir #$output)
 287           (chdir #$output)
 288
 289           (test-begin "mysql")
 290
 291           (test-assert "service running"
 292             (marionette-eval
 293              '(begin
 294                 (use-modules (gnu services herd))
 295                 (match (start-service 'mysql)
 296                   (#f #f)
 297                   (('service response-parts ...)
 298                    (match (assq-ref response-parts 'running)
 299                      ((pid) (number? pid))))))
 300              marionette))
 301
 302           (test-assert "mysql_upgrade completed"
 303             (wait-for-file "/var/lib/mysql/mysql_upgrade_info" marionette))
 304
 305           (test-eq "create database"
 306             0
 307             (marionette-eval
 308              '(begin
 309                 (system* #$(file-append mariadb "/bin/mysql")
 310                          "-e" "CREATE DATABASE guix;"))
 311              marionette))
 312
 313           (test-eq "create table"
 314             0
 315             (marionette-eval
 316              '(begin
 317                 (system*
 318                  #$(file-append mariadb "/bin/mysql") "guix"
 319                  "-e" "CREATE TABLE facts (id INT, data VARCHAR(12));"))
 320              marionette))
 321
 322           (test-eq "insert data"
 323             0
 324             (marionette-eval
 325              '(begin
 326                 (system* #$(file-append mariadb "/bin/mysql") "guix"
 327                          "-e" "INSERT INTO facts VALUES (1, 'awesome')"))
 328              marionette))
 329
 330           (test-equal "retrieve data"
 331             "awesome\n"
 332             (marionette-eval
 333              '(begin
 334                 (use-modules (ice-9 popen))
 335                 (let* ((port (open-pipe*
 336                               OPEN_READ
 337                               #$(file-append mariadb "/bin/mysql") "guix"
 338                               "-NB" "-e" "SELECT data FROM facts WHERE id=1;"))
 339                        (output (get-string-all port)))
 340                   (close-pipe port)
 341                   output))
 342              marionette))
 343
 344           (test-end)
 345           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 346
 347   (gexp->derivation "mysql-test" test))
 348
 349 (define %test-mysql
 350   (system-test
 351    (name "mysql")
 352    (description "Start the MySQL service.")
 353    (value (run-mysql-test))))