gnu/tests/web.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
   4 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
   5 ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu tests web)
  23   #:use-module (gnu tests)
  24   #:use-module (gnu system)
  25   #:use-module (gnu system file-systems)
  26   #:use-module (gnu system shadow)
  27   #:use-module (gnu system vm)
  28   #:use-module (gnu services)
  29   #:use-module (gnu services web)
  30   #:use-module (gnu services networking)
  31   #:use-module (guix gexp)
  32   #:use-module (guix store)
  33   #:export (%test-httpd
  34             %test-nginx
  35             %test-php-fpm
  36             %test-hpcguix-web))
  37
  38 (define %index.html-contents
  39   ;; Contents of the /index.html file.
  40   "Hello, guix!")
  41
  42 (define %make-http-root
  43   ;; Create our server root in /srv.
  44   #~(begin
  45       (mkdir "/srv")
  46       (mkdir "/srv/http")
  47       (call-with-output-file "/srv/http/index.html"
  48         (lambda (port)
  49           (display #$%index.html-contents port)))))
  50
  51 (define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080))
  52   "Run tests in %NGINX-OS, which has nginx running and listening on
  53 HTTP-PORT."
  54   (define os
  55     (marionette-operating-system
  56      test-os
  57      #:imported-modules '((gnu services herd)
  58                           (guix combinators))))
  59
  60   (define forwarded-port 8080)
  61
  62   (define vm
  63     (virtual-machine
  64      (operating-system os)
  65      (port-forwardings `((,http-port . ,forwarded-port)))))
  66
  67   (define test
  68     (with-imported-modules '((gnu build marionette))
  69       #~(begin
  70           (use-modules (srfi srfi-11) (srfi srfi-64)
  71                        (gnu build marionette)
  72                        (web uri)
  73                        (web client)
  74                        (web response))
  75
  76           (define marionette
  77             (make-marionette (list #$vm)))
  78
  79           (mkdir #$output)
  80           (chdir #$output)
  81
  82           (test-begin #$name)
  83
  84           (test-assert #$(string-append name " service running")
  85             (marionette-eval
  86              '(begin
  87                 (use-modules (gnu services herd))
  88                 (match (start-service '#$(string->symbol name))
  89                   (#f #f)
  90                   (('service response-parts ...)
  91                    (match (assq-ref response-parts 'running)
  92                      ((#t) #t)
  93                      ((pid) (number? pid))))))
  94              marionette))
  95
  96           ;; Retrieve the index.html file we put in /srv.
  97           (test-equal "http-get"
  98             '(200 #$%index.html-contents)
  99             (let-values
 100                 (((response text)
 101                   (http-get #$(simple-format
 102                                #f "http://localhost:~A/index.html" forwarded-port)
 103                             #:decode-body? #t)))
 104               (list (response-code response) text)))
 105
 106           #$@(if log-file
 107                  `((test-assert ,(string-append "log file exists " log-file)
 108                      (marionette-eval
 109                       '(file-exists? ,log-file)
 110                       marionette)))
 111                  '())
 112
 113           (test-end)
 114           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 115
 116   (gexp->derivation (string-append name "-test") test))
 117
 118 \f
 119 ;;;
 120 ;;; HTTPD
 121 ;;;
 122
 123 (define %httpd-os
 124   (simple-operating-system
 125    (dhcp-client-service)
 126    (service httpd-service-type
 127             (httpd-configuration
 128              (config
 129               (httpd-config-file
 130                (listen '("8080"))))))
 131    (simple-service 'make-http-root activation-service-type
 132                    %make-http-root)))
 133
 134 (define %test-httpd
 135   (system-test
 136    (name "httpd")
 137    (description "Connect to a running HTTPD server.")
 138    (value (run-webserver-test name %httpd-os
 139                               #:log-file "/var/log/httpd/error_log"))))
 140
 141 \f
 142 ;;;
 143 ;;; NGINX
 144 ;;;
 145
 146 (define %nginx-servers
 147   ;; Server blocks.
 148   (list (nginx-server-configuration
 149          (listen '("8080")))))
 150
 151 (define %nginx-os
 152   ;; Operating system under test.
 153   (simple-operating-system
 154    (dhcp-client-service)
 155    (service nginx-service-type
 156             (nginx-configuration
 157              (log-directory "/var/log/nginx")
 158              (server-blocks %nginx-servers)))
 159    (simple-service 'make-http-root activation-service-type
 160                    %make-http-root)))
 161
 162 (define %test-nginx
 163   (system-test
 164    (name "nginx")
 165    (description "Connect to a running NGINX server.")
 166    (value (run-webserver-test name %nginx-os
 167                               #:log-file "/var/log/nginx/access.log"))))
 168
 169 \f
 170 ;;;
 171 ;;; PHP-FPM
 172 ;;;
 173
 174 (define %make-php-fpm-http-root
 175   ;; Create our server root in /srv.
 176   #~(begin
 177       (mkdir "/srv")
 178       (call-with-output-file "/srv/index.php"
 179         (lambda (port)
 180           (display "<?php
 181 phpinfo();
 182 echo(\"Computed by php:\".((string)(2+3)));
 183 ?>\n" port)))))
 184
 185 (define %php-fpm-nginx-server-blocks
 186   (list (nginx-server-configuration
 187          (root "/srv")
 188          (locations
 189           (list (nginx-php-location)))
 190          (listen '("8042"))
 191          (ssl-certificate #f)
 192          (ssl-certificate-key #f))))
 193
 194 (define %php-fpm-os
 195   ;; Operating system under test.
 196   (simple-operating-system
 197    (dhcp-client-service)
 198    (service php-fpm-service-type)
 199    (service nginx-service-type
 200             (nginx-configuration
 201              (server-blocks %php-fpm-nginx-server-blocks)))
 202    (simple-service 'make-http-root activation-service-type
 203                    %make-php-fpm-http-root)))
 204
 205 (define* (run-php-fpm-test #:optional (http-port 8042))
 206   "Run tests in %PHP-FPM-OS, which has nginx running and listening on
 207 HTTP-PORT, along with php-fpm."
 208   (define os
 209     (marionette-operating-system
 210      %php-fpm-os
 211      #:imported-modules '((gnu services herd)
 212                           (guix combinators))))
 213
 214   (define vm
 215     (virtual-machine
 216      (operating-system os)
 217      (port-forwardings `((8080 . ,http-port)))))
 218
 219   (define test
 220     (with-imported-modules '((gnu build marionette)
 221                              (guix build utils))
 222       #~(begin
 223           (use-modules (srfi srfi-11) (srfi srfi-64)
 224                        (gnu build marionette)
 225                        (web uri)
 226                        (web client)
 227                        (web response))
 228
 229           (define marionette
 230             (make-marionette (list #$vm)))
 231
 232           (mkdir #$output)
 233           (chdir #$output)
 234
 235           (test-begin "php-fpm")
 236
 237           (test-assert "php-fpm running"
 238             (marionette-eval
 239              '(begin
 240                 (use-modules (gnu services herd))
 241                 (match (start-service 'php-fpm)
 242                   (#f #f)
 243                   (('service response-parts ...)
 244                    (match (assq-ref response-parts 'running)
 245                      ((pid) (number? pid))))))
 246              marionette))
 247
 248           (test-assert "nginx running"
 249             (marionette-eval
 250              '(begin
 251                 (use-modules (gnu services herd))
 252                 (start-service 'nginx))
 253              marionette))
 254
 255           (test-equal "http-get"
 256             200
 257             (let-values (((response text)
 258                           (http-get "http://localhost:8080/index.php"
 259                                     #:decode-body? #t)))
 260               (response-code response)))
 261
 262           (test-equal "php computed result is sent"
 263             "Computed by php:5"
 264             (let-values (((response text)
 265                           (http-get "http://localhost:8080/index.php"
 266                                     #:decode-body? #t)))
 267               (begin
 268                 (use-modules (ice-9 regex))
 269                 (let ((matches (string-match "Computed by php:5" text)))
 270                   (and matches
 271                        (match:substring matches 0))))))
 272
 273           (test-end)
 274
 275           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 276
 277   (gexp->derivation "php-fpm-test" test))
 278
 279 (define %test-php-fpm
 280   (system-test
 281    (name "php-fpm")
 282    (description "Test PHP-FPM through nginx.")
 283    (value (run-php-fpm-test))))
 284
 285 \f
 286 ;;;
 287 ;;; hpcguix-web
 288 ;;;
 289
 290 (define* (run-hpcguix-web-server-test name test-os)
 291   "Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running."
 292   (define os
 293     (marionette-operating-system
 294      test-os
 295      #:imported-modules '((gnu services herd)
 296                           (guix combinators))))
 297
 298   (define vm
 299     (virtual-machine
 300      (operating-system os)
 301      (port-forwardings '((8080 . 5000)))))
 302
 303   (define test
 304     (with-imported-modules '((gnu build marionette))
 305       #~(begin
 306           (use-modules (srfi srfi-11) (srfi srfi-64)
 307                        (gnu build marionette)
 308                        (web uri)
 309                        (web client)
 310                        (web response))
 311
 312           (define marionette
 313             (make-marionette (list #$vm)))
 314
 315           (mkdir #$output)
 316           (chdir #$output)
 317
 318           (test-begin #$name)
 319
 320           (test-assert "hpcguix-web running"
 321             (marionette-eval
 322              '(begin
 323                 (use-modules (gnu services herd))
 324                 (match (start-service 'hpcguix-web)
 325                   (#f #f)
 326                   (('service response-parts ...)
 327                    (match (assq-ref response-parts 'running)
 328                      ((pid) (number? pid))))))
 329              marionette))
 330
 331           (test-equal "http-get"
 332             200
 333             (begin
 334               (wait-for-tcp-port 5000 marionette)
 335               (let-values (((response text)
 336                             (http-get "http://localhost:8080")))
 337                 (response-code response))))
 338
 339           (test-end)
 340           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 341
 342   (gexp->derivation (string-append name "-test") test))
 343
 344 (define %hpcguix-web-specs
 345   ;; Server config gexp.
 346   #~(define site-config
 347       (hpcweb-configuration
 348        (title-prefix "[TEST] HPCGUIX-WEB"))))
 349
 350 (define %hpcguix-web-os
 351   (simple-operating-system
 352    (dhcp-client-service)
 353    (service hpcguix-web-service-type
 354             (hpcguix-web-configuration
 355              (specs %hpcguix-web-specs)))))
 356
 357 (define %test-hpcguix-web
 358   (system-test
 359    (name "hpcguix-web")
 360    (description "Connect to a running hpcguix-web server.")
 361    (value (run-hpcguix-web-server-test name %hpcguix-web-os))))