gnu/tests/docker.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu tests docker)
  20   #:use-module (gnu tests)
  21   #:use-module (gnu system)
  22   #:use-module (gnu system file-systems)
  23   #:use-module (gnu system vm)
  24   #:use-module (gnu services)
  25   #:use-module (gnu services dbus)
  26   #:use-module (gnu services networking)
  27   #:use-module (gnu services docker)
  28   #:use-module (gnu services desktop)
  29   #:use-module (gnu packages docker)
  30   #:use-module (guix gexp)
  31   #:use-module (guix store)
  32   #:export (%test-docker))
  33
  34 (define %docker-os
  35   (simple-operating-system
  36    (service dhcp-client-service-type)
  37    (dbus-service)
  38    (polkit-service)
  39    (service elogind-service-type)
  40    (service docker-service-type)))
  41
  42 (define (run-docker-test)
  43   "Run tests in %DOCKER-OS."
  44   (define os
  45     (marionette-operating-system
  46      %docker-os
  47      #:imported-modules '((gnu services herd)
  48                           (guix combinators))))
  49
  50   (define vm
  51     (virtual-machine
  52      (operating-system os)
  53      (memory-size 500)
  54      (disk-image-size (* 250 (expt 2 20)))
  55      (port-forwardings '())))
  56
  57   (define test
  58     (with-imported-modules '((gnu build marionette))
  59       #~(begin
  60           (use-modules (srfi srfi-11) (srfi srfi-64)
  61                        (gnu build marionette))
  62
  63           (define marionette
  64             (make-marionette (list #$vm)))
  65
  66           (mkdir #$output)
  67           (chdir #$output)
  68
  69           (test-begin "docker")
  70
  71           (test-assert "service running"
  72             (marionette-eval
  73              '(begin
  74                 (use-modules (gnu services herd))
  75                 (match (start-service 'dockerd)
  76                   (#f #f)
  77                   (('service response-parts ...)
  78                    (match (assq-ref response-parts 'running)
  79                      ((pid) (number? pid))))))
  80              marionette))
  81
  82           (test-eq "fetch version"
  83             0
  84             (marionette-eval
  85              `(begin
  86                 (system* ,(string-append #$docker-cli "/bin/docker")
  87                          "version"))
  88              marionette))
  89
  90           (test-end)
  91           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
  92
  93   (gexp->derivation "docker-test" test))
  94
  95 (define %test-docker
  96   (system-test
  97    (name "docker")
  98    (description "Connect to the running Docker service.")
  99    (value (run-docker-test))))