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 ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu tests web)
  24   #:use-module (gnu tests)
  25   #:use-module (gnu system)
  26   #:use-module (gnu system file-systems)
  27   #:use-module (gnu system shadow)
  28   #:use-module (gnu system vm)
  29   #:use-module (gnu services)
  30   #:use-module (gnu services web)
  31   #:use-module (gnu services networking)
  32   #:use-module (guix gexp)
  33   #:use-module (guix store)
  34   #:export (%test-httpd
  35             %test-nginx
  36             %test-varnish
  37             %test-php-fpm
  38             %test-hpcguix-web
  39             %test-tailon))
  40
  41 (define %index.html-contents
  42   ;; Contents of the /index.html file.
  43   "Hello, guix!")
  44
  45 (define %make-http-root
  46   ;; Create our server root in /srv.
  47   #~(begin
  48       (mkdir "/srv")
  49       (mkdir "/srv/http")
  50       (call-with-output-file "/srv/http/index.html"
  51         (lambda (port)
  52           (display #$%index.html-contents port)))))
  53
  54 (define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080))
  55   "Run tests in %NGINX-OS, which has nginx running and listening on
  56 HTTP-PORT."
  57   (define os
  58     (marionette-operating-system
  59      test-os
  60      #:imported-modules '((gnu services herd)
  61                           (guix combinators))))
  62
  63   (define forwarded-port 8080)
  64
  65   (define vm
  66     (virtual-machine
  67      (operating-system os)
  68      (port-forwardings `((,http-port . ,forwarded-port)))))
  69
  70   (define test
  71     (with-imported-modules '((gnu build marionette))
  72       #~(begin
  73           (use-modules (srfi srfi-11) (srfi srfi-64)
  74                        (gnu build marionette)
  75                        (web uri)
  76                        (web client)
  77                        (web response))
  78
  79           (define marionette
  80             (make-marionette (list #$vm)))
  81
  82           (mkdir #$output)
  83           (chdir #$output)
  84
  85           (test-begin #$name)
  86
  87           (test-assert #$(string-append name " service running")
  88             (marionette-eval
  89              '(begin
  90                 (use-modules (gnu services herd))
  91                 (match (start-service '#$(string->symbol name))
  92                   (#f #f)
  93                   (('service response-parts ...)
  94                    (match (assq-ref response-parts 'running)
  95                      ((#t) #t)
  96                      ((pid) (number? pid))))))
  97              marionette))
  98
  99           ;; Retrieve the index.html file we put in /srv.
 100           (test-equal "http-get"
 101             '(200 #$%index.html-contents)
 102             (let-values
 103                 (((response text)
 104                   (http-get #$(simple-format
 105                                #f "http://localhost:~A/index.html" forwarded-port)
 106                             #:decode-body? #t)))
 107               (list (response-code response) text)))
 108
 109           #$@(if log-file
 110                  `((test-assert ,(string-append "log file exists " log-file)
 111                      (marionette-eval
 112                       '(file-exists? ,log-file)
 113                       marionette)))
 114                  '())
 115
 116           (test-end)
 117           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 118
 119   (gexp->derivation (string-append name "-test") test))
 120
 121 \f
 122 ;;;
 123 ;;; HTTPD
 124 ;;;
 125
 126 (define %httpd-os
 127   (simple-operating-system
 128    (dhcp-client-service)
 129    (service httpd-service-type
 130             (httpd-configuration
 131              (config
 132               (httpd-config-file
 133                (listen '("8080"))))))
 134    (simple-service 'make-http-root activation-service-type
 135                    %make-http-root)))
 136
 137 (define %test-httpd
 138   (system-test
 139    (name "httpd")
 140    (description "Connect to a running HTTPD server.")
 141    (value (run-webserver-test name %httpd-os
 142                               #:log-file "/var/log/httpd/error_log"))))
 143
 144 \f
 145 ;;;
 146 ;;; NGINX
 147 ;;;
 148
 149 (define %nginx-servers
 150   ;; Server blocks.
 151   (list (nginx-server-configuration
 152          (listen '("8080")))))
 153
 154 (define %nginx-os
 155   ;; Operating system under test.
 156   (simple-operating-system
 157    (dhcp-client-service)
 158    (service nginx-service-type
 159             (nginx-configuration
 160              (log-directory "/var/log/nginx")
 161              (server-blocks %nginx-servers)))
 162    (simple-service 'make-http-root activation-service-type
 163                    %make-http-root)))
 164
 165 (define %test-nginx
 166   (system-test
 167    (name "nginx")
 168    (description "Connect to a running NGINX server.")
 169    (value (run-webserver-test name %nginx-os
 170                               #:log-file "/var/log/nginx/access.log"))))
 171
 172 \f
 173 ;;;
 174 ;;; Varnish
 175 ;;;
 176
 177 (define %varnish-vcl
 178   (mixed-text-file
 179    "varnish-test.vcl"
 180    "vcl 4.0;
 181 backend dummy { .host = \"127.1.1.1\"; }
 182 sub vcl_recv { return(synth(200, \"OK\")); }
 183 sub vcl_synth {
 184   synthetic(\"" %index.html-contents "\");
 185   set resp.http.Content-Type = \"text/plain\";
 186   return(deliver);
 187 }"))
 188
 189 (define %varnish-os
 190   (simple-operating-system
 191    (dhcp-client-service)
 192    ;; Pretend to be a web server that serves %index.html-contents.
 193    (service varnish-service-type
 194             (varnish-configuration
 195              (name "/tmp/server")
 196              ;; Use a small VSL buffer to fit in the test VM.
 197              (parameters '(("vsl_space" . "4M")))
 198              (vcl %varnish-vcl)))
 199    ;; Proxy the "server" using the builtin configuration.
 200    (service varnish-service-type
 201             (varnish-configuration
 202              (parameters '(("vsl_space" . "4M")))
 203              (backend "localhost:80")
 204              (listen '(":8080"))))))
 205
 206 (define %test-varnish
 207   (system-test
 208    (name "varnish")
 209    (description "Test the Varnish Cache server.")
 210    (value (run-webserver-test "varnish-default" %varnish-os))))
 211
 212 \f
 213 ;;;
 214 ;;; PHP-FPM
 215 ;;;
 216
 217 (define %make-php-fpm-http-root
 218   ;; Create our server root in /srv.
 219   #~(begin
 220       (mkdir "/srv")
 221       (call-with-output-file "/srv/index.php"
 222         (lambda (port)
 223           (display "<?php
 224 phpinfo();
 225 echo(\"Computed by php:\".((string)(2+3)));
 226 ?>\n" port)))))
 227
 228 (define %php-fpm-nginx-server-blocks
 229   (list (nginx-server-configuration
 230          (root "/srv")
 231          (locations
 232           (list (nginx-php-location)))
 233          (listen '("8042"))
 234          (ssl-certificate #f)
 235          (ssl-certificate-key #f))))
 236
 237 (define %php-fpm-os
 238   ;; Operating system under test.
 239   (simple-operating-system
 240    (dhcp-client-service)
 241    (service php-fpm-service-type)
 242    (service nginx-service-type
 243             (nginx-configuration
 244              (server-blocks %php-fpm-nginx-server-blocks)))
 245    (simple-service 'make-http-root activation-service-type
 246                    %make-php-fpm-http-root)))
 247
 248 (define* (run-php-fpm-test #:optional (http-port 8042))
 249   "Run tests in %PHP-FPM-OS, which has nginx running and listening on
 250 HTTP-PORT, along with php-fpm."
 251   (define os
 252     (marionette-operating-system
 253      %php-fpm-os
 254      #:imported-modules '((gnu services herd)
 255                           (guix combinators))))
 256
 257   (define vm
 258     (virtual-machine
 259      (operating-system os)
 260      (port-forwardings `((8080 . ,http-port)))))
 261
 262   (define test
 263     (with-imported-modules '((gnu build marionette)
 264                              (guix build utils))
 265       #~(begin
 266           (use-modules (srfi srfi-11) (srfi srfi-64)
 267                        (gnu build marionette)
 268                        (web uri)
 269                        (web client)
 270                        (web response))
 271
 272           (define marionette
 273             (make-marionette (list #$vm)))
 274
 275           (mkdir #$output)
 276           (chdir #$output)
 277
 278           (test-begin "php-fpm")
 279
 280           (test-assert "php-fpm running"
 281             (marionette-eval
 282              '(begin
 283                 (use-modules (gnu services herd))
 284                 (match (start-service 'php-fpm)
 285                   (#f #f)
 286                   (('service response-parts ...)
 287                    (match (assq-ref response-parts 'running)
 288                      ((pid) (number? pid))))))
 289              marionette))
 290
 291           (test-assert "nginx running"
 292             (marionette-eval
 293              '(begin
 294                 (use-modules (gnu services herd))
 295                 (start-service 'nginx))
 296              marionette))
 297
 298           (test-equal "http-get"
 299             200
 300             (let-values (((response text)
 301                           (http-get "http://localhost:8080/index.php"
 302                                     #:decode-body? #t)))
 303               (response-code response)))
 304
 305           (test-equal "php computed result is sent"
 306             "Computed by php:5"
 307             (let-values (((response text)
 308                           (http-get "http://localhost:8080/index.php"
 309                                     #:decode-body? #t)))
 310               (begin
 311                 (use-modules (ice-9 regex))
 312                 (let ((matches (string-match "Computed by php:5" text)))
 313                   (and matches
 314                        (match:substring matches 0))))))
 315
 316           (test-end)
 317
 318           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 319
 320   (gexp->derivation "php-fpm-test" test))
 321
 322 (define %test-php-fpm
 323   (system-test
 324    (name "php-fpm")
 325    (description "Test PHP-FPM through nginx.")
 326    (value (run-php-fpm-test))))
 327
 328 \f
 329 ;;;
 330 ;;; hpcguix-web
 331 ;;;
 332
 333 (define* (run-hpcguix-web-server-test name test-os)
 334   "Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running."
 335   (define os
 336     (marionette-operating-system
 337      test-os
 338      #:imported-modules '((gnu services herd)
 339                           (guix combinators))))
 340
 341   (define vm
 342     (virtual-machine
 343      (operating-system os)
 344      (port-forwardings '((8080 . 5000)))))
 345
 346   (define test
 347     (with-imported-modules '((gnu build marionette))
 348       #~(begin
 349           (use-modules (srfi srfi-11) (srfi srfi-64)
 350                        (gnu build marionette)
 351                        (web uri)
 352                        (web client)
 353                        (web response))
 354
 355           (define marionette
 356             (make-marionette (list #$vm)))
 357
 358           (mkdir #$output)
 359           (chdir #$output)
 360
 361           (test-begin #$name)
 362
 363           (test-assert "hpcguix-web running"
 364             (marionette-eval
 365              '(begin
 366                 (use-modules (gnu services herd))
 367                 (match (start-service 'hpcguix-web)
 368                   (#f #f)
 369                   (('service response-parts ...)
 370                    (match (assq-ref response-parts 'running)
 371                      ((pid) (number? pid))))))
 372              marionette))
 373
 374           (test-equal "http-get"
 375             200
 376             (begin
 377               (wait-for-tcp-port 5000 marionette)
 378               (let-values (((response text)
 379                             (http-get "http://localhost:8080")))
 380                 (response-code response))))
 381
 382           (test-end)
 383           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 384
 385   (gexp->derivation (string-append name "-test") test))
 386
 387 (define %hpcguix-web-specs
 388   ;; Server config gexp.
 389   #~(define site-config
 390       (hpcweb-configuration
 391        (title-prefix "[TEST] HPCGUIX-WEB"))))
 392
 393 (define %hpcguix-web-os
 394   (simple-operating-system
 395    (dhcp-client-service)
 396    (service hpcguix-web-service-type
 397             (hpcguix-web-configuration
 398              (specs %hpcguix-web-specs)))))
 399
 400 (define %test-hpcguix-web
 401   (system-test
 402    (name "hpcguix-web")
 403    (description "Connect to a running hpcguix-web server.")
 404    (value (run-hpcguix-web-server-test name %hpcguix-web-os))))
 405
 406 \f
 407 (define %tailon-os
 408   ;; Operating system under test.
 409   (simple-operating-system
 410    (dhcp-client-service)
 411    (service tailon-service-type
 412             (tailon-configuration
 413              (config-file
 414               (tailon-configuration-file
 415                (bind "0.0.0.0:8080")))))))
 416
 417 (define* (run-tailon-test #:optional (http-port 8081))
 418   "Run tests in %TAILON-OS, which has tailon running and listening on
 419 HTTP-PORT."
 420   (define os
 421     (marionette-operating-system
 422      %tailon-os
 423      #:imported-modules '((gnu services herd)
 424                           (guix combinators))))
 425
 426   (define vm
 427     (virtual-machine
 428      (operating-system os)
 429      (port-forwardings `((,http-port . 8080)))))
 430
 431   (define test
 432     (with-imported-modules '((gnu build marionette))
 433       #~(begin
 434           (use-modules (srfi srfi-11) (srfi srfi-64)
 435                        (ice-9 match)
 436                        (gnu build marionette)
 437                        (web uri)
 438                        (web client)
 439                        (web response))
 440
 441           (define marionette
 442             ;; Forward the guest's HTTP-PORT, where tailon is listening, to
 443             ;; port 8080 in the host.
 444             (make-marionette (list #$vm)))
 445
 446           (mkdir #$output)
 447           (chdir #$output)
 448
 449           (test-begin "tailon")
 450
 451           (test-assert "service running"
 452             (marionette-eval
 453              '(begin
 454                 (use-modules (gnu services herd))
 455                 (start-service 'tailon))
 456              marionette))
 457
 458           (define* (retry-on-error f #:key times delay)
 459             (let loop ((attempt 1))
 460               (match (catch
 461                       #t
 462                       (lambda ()
 463                         (cons #t
 464                               (f)))
 465                       (lambda args
 466                         (cons #f
 467                               args)))
 468                 ((#t . return-value)
 469                  return-value)
 470                 ((#f . error-args)
 471                  (if (>= attempt times)
 472                      error-args
 473                      (begin
 474                        (sleep delay)
 475                        (loop (+ 1 attempt))))))))
 476
 477           (test-equal "http-get"
 478             200
 479             (retry-on-error
 480              (lambda ()
 481                (let-values (((response text)
 482                              (http-get #$(format
 483                                           #f
 484                                           "http://localhost:~A/"
 485                                           http-port)
 486                                        #:decode-body? #t)))
 487                  (response-code response)))
 488              #:times 10
 489              #:delay 5))
 490
 491           (test-end)
 492           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 493
 494   (gexp->derivation "tailon-test" test))
 495
 496 (define %test-tailon
 497   (system-test
 498    (name "tailon")
 499    (description "Connect to a running Tailon server.")
 500    (value (run-tailon-test))))