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