| 1 | |
| 2 | |
| 3 | |
| 4 | |
| 5 | |
| 6 | |
| 7 | |
| 8 | |
| 9 | |
| 10 | |
| 11 | |
| 12 | |
| 13 | |
| 14 | |
| 15 | |
| 16 | |
| 17 | |
| 18 | |
| 19 | |
| 20 |
|
| 21 | (define-module (gnu tests docker)
|
| 22 | #:use-module (gnu image)
|
| 23 | #:use-module (gnu tests)
|
| 24 | #:use-module (gnu system)
|
| 25 | #:use-module (gnu system file-systems)
|
| 26 | #:use-module (gnu system image)
|
| 27 | #:use-module (gnu system vm)
|
| 28 | #:use-module (gnu services)
|
| 29 | #:use-module (gnu services dbus)
|
| 30 | #:use-module (gnu services networking)
|
| 31 | #:use-module (gnu services docker)
|
| 32 | #:use-module (gnu services desktop)
|
| 33 | #:use-module (gnu packages)
|
| 34 | #:use-module ((gnu packages base) #:select (glibc))
|
| 35 | #:use-module (gnu packages guile)
|
| 36 | #:use-module (gnu packages docker)
|
| 37 | #:use-module (guix gexp)
|
| 38 | #:use-module (guix grafts)
|
| 39 | #:use-module (guix monads)
|
| 40 | #:use-module (guix packages)
|
| 41 | #:use-module (guix profiles)
|
| 42 | #:use-module ((guix scripts pack) #:prefix pack:)
|
| 43 | #:use-module (guix store)
|
| 44 | #:use-module (guix tests)
|
| 45 | #:use-module (guix build-system trivial)
|
| 46 | #:use-module ((guix licenses) #:prefix license:)
|
| 47 | #:export (%test-docker
|
| 48 | %test-docker-system
|
| 49 | %test-oci-container))
|
| 50 |
|
| 51 | (define %docker-os
|
| 52 | (simple-operating-system
|
| 53 | (service dhcpcd-service-type)
|
| 54 | (service dbus-root-service-type)
|
| 55 | (service polkit-service-type)
|
| 56 | (service elogind-service-type)
|
| 57 | (service containerd-service-type)
|
| 58 | (service docker-service-type)))
|
| 59 |
|
| 60 | (define (run-docker-test docker-tarball)
|
| 61 | "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
|
| 62 | inside %DOCKER-OS."
|
| 63 | (define os
|
| 64 | (marionette-operating-system
|
| 65 | (operating-system-with-gc-roots
|
| 66 | %docker-os
|
| 67 | (list docker-tarball))
|
| 68 | #:imported-modules '((gnu services herd)
|
| 69 | (guix combinators))))
|
| 70 |
|
| 71 | (define vm
|
| 72 | (virtual-machine
|
| 73 | (operating-system os)
|
| 74 | (volatile? #f)
|
| 75 | (memory-size 1024)
|
| 76 | (disk-image-size (* 3000 (expt 2 20)))
|
| 77 | (port-forwardings '())))
|
| 78 |
|
| 79 | (define test
|
| 80 | (with-imported-modules '((gnu build marionette))
|
| 81 | #~(begin
|
| 82 | (use-modules (srfi srfi-11) (srfi srfi-64)
|
| 83 | (gnu build marionette))
|
| 84 |
|
| 85 | (define marionette
|
| 86 | |
| 87 | (make-marionette (list #$vm) #:timeout 60))
|
| 88 |
|
| 89 | (test-runner-current (system-test-runner #$output))
|
| 90 | (test-begin "docker")
|
| 91 |
|
| 92 | (test-assert "containerd service running"
|
| 93 | (marionette-eval
|
| 94 | '(begin
|
| 95 | (use-modules (gnu services herd))
|
| 96 | (match (start-service 'containerd)
|
| 97 | (#f #f)
|
| 98 | (('service response-parts ...)
|
| 99 | (match (assq-ref response-parts 'running)
|
| 100 | ((pid) pid)))))
|
| 101 | marionette))
|
| 102 |
|
| 103 | (test-assert "containerd PID file present"
|
| 104 | (wait-for-file "/run/containerd/containerd.pid" marionette))
|
| 105 |
|
| 106 | (test-assert "dockerd service running"
|
| 107 | (marionette-eval
|
| 108 | '(begin
|
| 109 | (use-modules (gnu services herd))
|
| 110 | (match (start-service 'dockerd)
|
| 111 | (#f #f)
|
| 112 | (('service response-parts ...)
|
| 113 | (match (assq-ref response-parts 'running)
|
| 114 | ((pid) pid)))))
|
| 115 | marionette))
|
| 116 |
|
| 117 | (test-eq "fetch version"
|
| 118 | 0
|
| 119 | (marionette-eval
|
| 120 | `(begin
|
| 121 | (system* ,(string-append #$docker-cli "/bin/docker")
|
| 122 | "version"))
|
| 123 | marionette))
|
| 124 |
|
| 125 | (test-equal "Load docker image and run it"
|
| 126 | '("hello world" "hi!" "JSON!" #o1777)
|
| 127 | (marionette-eval
|
| 128 | `(begin
|
| 129 | (use-modules (ice-9 popen)
|
| 130 | (ice-9 rdelim))
|
| 131 |
|
| 132 | (define slurp
|
| 133 | (lambda args
|
| 134 | (let* ((port (apply open-pipe* OPEN_READ args))
|
| 135 | (output (read-line port))
|
| 136 | (status (close-pipe port)))
|
| 137 | output)))
|
| 138 | (let* ((raw-line (slurp ,(string-append #$docker-cli
|
| 139 | "/bin/docker")
|
| 140 | "load" "-i"
|
| 141 | ,#$docker-tarball))
|
| 142 | (repository&tag (string-drop raw-line
|
| 143 | (string-length
|
| 144 | "Loaded image: ")))
|
| 145 | (response1 (slurp
|
| 146 | ,(string-append #$docker-cli "/bin/docker")
|
| 147 | "run" "--entrypoint" "bin/Guile"
|
| 148 | repository&tag
|
| 149 | "/aa.scm"))
|
| 150 | (response2 (slurp |
| 151 | ,(string-append #$docker-cli "/bin/docker")
|
| 152 | "run" repository&tag
|
| 153 | "-c" "(display \"hi!\")"))
|
| 154 |
|
| 155 | |
| 156 | (response3 (slurp |
| 157 | ,(string-append #$docker-cli "/bin/docker")
|
| 158 | "run" repository&tag
|
| 159 | "-c" "(use-modules (json))
|
| 160 | (display (json-string->scm (scm->json-string \"JSON!\")))"))
|
| 161 |
|
| 162 | |
| 163 | (response4 (slurp
|
| 164 | ,(string-append #$docker-cli "/bin/docker")
|
| 165 | "run" repository&tag "-c"
|
| 166 | "(display (stat:perms (lstat \"/tmp\")))")))
|
| 167 | (list response1 response2 response3
|
| 168 | (string->number response4))))
|
| 169 | marionette))
|
| 170 |
|
| 171 | (test-end))))
|
| 172 |
|
| 173 | (gexp->derivation "docker-test" test))
|
| 174 |
|
| 175 | (define (build-tarball&run-docker-test)
|
| 176 | (mlet* %store-monad
|
| 177 | ((_ (set-grafting #f))
|
| 178 | (guile (set-guile-for-build (default-guile)))
|
| 179 | (guest-script-package ->
|
| 180 | (package
|
| 181 | (name "guest-script")
|
| 182 | (version "0")
|
| 183 | (source #f)
|
| 184 | (build-system trivial-build-system)
|
| 185 | (arguments `(#:guile ,guile-3.0
|
| 186 | #:builder
|
| 187 | (let ((out (assoc-ref %outputs "out")))
|
| 188 | (mkdir out)
|
| 189 | (call-with-output-file (string-append out "/a.scm")
|
| 190 | (lambda (port)
|
| 191 | (display "(display \"hello world\n\")" port)))
|
| 192 | #t)))
|
| 193 | (synopsis "Display hello world using Guile")
|
| 194 | (description "This package displays the text \"hello world\" on the
|
| 195 | standard output device and then enters a new line.")
|
| 196 | (home-page #f)
|
| 197 | (license license:public-domain)))
|
| 198 | (profile (profile-derivation (packages->manifest
|
| 199 | (list guile-3.0 guile-json-3
|
| 200 | guest-script-package))
|
| 201 | #:hooks '()
|
| 202 | #:locales? #f))
|
| 203 | (tarball (pack:docker-image
|
| 204 | "docker-pack" profile
|
| 205 | #:symlinks '(("/bin/Guile" -> "bin/guile")
|
| 206 | ("aa.scm" -> "a.scm"))
|
| 207 | #:entry-point "bin/guile"
|
| 208 | #:localstatedir? #t)))
|
| 209 | (run-docker-test tarball)))
|
| 210 |
|
| 211 | (define %test-docker
|
| 212 | (system-test
|
| 213 | (name "docker")
|
| 214 | (description "Test Docker container of Guix.")
|
| 215 | (value (build-tarball&run-docker-test))))
|
| 216 |
|
| 217 |
|
| 218 | (define (run-docker-system-test tarball)
|
| 219 | "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
|
| 220 | inside %DOCKER-OS."
|
| 221 | (define os
|
| 222 | (marionette-operating-system
|
| 223 | (operating-system-with-gc-roots
|
| 224 | %docker-os
|
| 225 | (list tarball))
|
| 226 | #:imported-modules '((gnu services herd)
|
| 227 | (guix combinators))))
|
| 228 |
|
| 229 | (define vm
|
| 230 | (virtual-machine
|
| 231 | (operating-system os)
|
| 232 | (volatile? #f)
|
| 233 | (disk-image-size (* 6000 (expt 2 20)))
|
| 234 | (memory-size 2048)
|
| 235 | (port-forwardings '())))
|
| 236 |
|
| 237 | (define test
|
| 238 | (with-imported-modules '((gnu build marionette)
|
| 239 | (guix build utils))
|
| 240 | #~(begin
|
| 241 | (use-modules (srfi srfi-11) (srfi srfi-64)
|
| 242 | (gnu build marionette)
|
| 243 | (guix build utils))
|
| 244 |
|
| 245 | (define marionette
|
| 246 | |
| 247 | (make-marionette (list #$vm) #:timeout 60))
|
| 248 |
|
| 249 | (test-runner-current (system-test-runner #$output))
|
| 250 | (test-begin "docker")
|
| 251 |
|
| 252 | (test-assert "containerd service running"
|
| 253 | (marionette-eval
|
| 254 | '(begin
|
| 255 | (use-modules (gnu services herd))
|
| 256 | (match (start-service 'containerd)
|
| 257 | (#f #f)
|
| 258 | (('service response-parts ...)
|
| 259 | (match (assq-ref response-parts 'running)
|
| 260 | ((pid) pid)))))
|
| 261 | marionette))
|
| 262 |
|
| 263 | (test-assert "containerd PID file present"
|
| 264 | (wait-for-file "/run/containerd/containerd.pid" marionette))
|
| 265 |
|
| 266 | (test-assert "service running"
|
| 267 | (marionette-eval
|
| 268 | '(begin
|
| 269 | (use-modules (gnu services herd))
|
| 270 | (match (start-service 'dockerd)
|
| 271 | (#f #f)
|
| 272 | (('service response-parts ...)
|
| 273 | (match (assq-ref response-parts 'running)
|
| 274 | ((pid) pid)))))
|
| 275 | marionette))
|
| 276 |
|
| 277 | (test-assert "load system image and run it"
|
| 278 | (marionette-eval
|
| 279 | `(begin
|
| 280 | (use-modules (ice-9 popen)
|
| 281 | (ice-9 rdelim)
|
| 282 | (guix build utils))
|
| 283 |
|
| 284 | (define (slurp command . args)
|
| 285 | |
| 286 | (let* ((port (apply open-pipe* OPEN_READ command args))
|
| 287 | (output (read-line port))
|
| 288 | (status (close-pipe port)))
|
| 289 | output))
|
| 290 |
|
| 291 | (define (docker-cli command . args)
|
| 292 | |
| 293 | (apply invoke #$(file-append docker-cli "/bin/docker")
|
| 294 | command args))
|
| 295 |
|
| 296 | (define (wait-for-container-file container file)
|
| 297 | |
| 298 | (docker-cli "exec" container
|
| 299 | #$(file-append guile-3.0 "/bin/guile")
|
| 300 | "-c"
|
| 301 | (object->string
|
| 302 | `(let loop ((n 15))
|
| 303 | (when (zero? n)
|
| 304 | (error "file didn't show up" ,file))
|
| 305 | (unless (file-exists? ,file)
|
| 306 | (sleep 1)
|
| 307 | (loop (- n 1)))))))
|
| 308 |
|
| 309 | (let* ((line (slurp #$(file-append docker-cli "/bin/docker")
|
| 310 | "load" "-i" #$tarball))
|
| 311 | (repository&tag (string-drop line
|
| 312 | (string-length
|
| 313 | "Loaded image: ")))
|
| 314 | (container (slurp
|
| 315 | #$(file-append docker-cli "/bin/docker")
|
| 316 | "create" repository&tag)))
|
| 317 | (docker-cli "start" container)
|
| 318 |
|
| 319 | |
| 320 | (wait-for-container-file container
|
| 321 | "/var/run/shepherd/socket")
|
| 322 |
|
| 323 | (docker-cli "exec" container
|
| 324 | "/run/current-system/profile/bin/herd"
|
| 325 | "status")
|
| 326 | (slurp #$(file-append docker-cli "/bin/docker")
|
| 327 | "exec" container
|
| 328 | "/run/current-system/profile/bin/herd"
|
| 329 | "status" "guix-daemon")))
|
| 330 | marionette))
|
| 331 |
|
| 332 | (test-end))))
|
| 333 |
|
| 334 | (gexp->derivation "docker-system-test" test))
|
| 335 |
|
| 336 | (define %test-docker-system
|
| 337 | (system-test
|
| 338 | (name "docker-system")
|
| 339 | (description "Run a system image as produced by @command{guix system
|
| 340 | docker-image} inside Docker.")
|
| 341 | (value (with-monad %store-monad
|
| 342 | (>>= (lower-object
|
| 343 | (system-image (os->image
|
| 344 | (operating-system
|
| 345 | (inherit (simple-operating-system))
|
| 346 | |
| 347 | |
| 348 | (locale-libcs (list glibc)))
|
| 349 | #:type docker-image-type)))
|
| 350 | run-docker-system-test)))))
|
| 351 |
|
| 352 |
|
| 353 | (define %oci-os
|
| 354 | (simple-operating-system
|
| 355 | (service dhcpcd-service-type)
|
| 356 | (service dbus-root-service-type)
|
| 357 | (service polkit-service-type)
|
| 358 | (service elogind-service-type)
|
| 359 | (service containerd-service-type)
|
| 360 | (service docker-service-type)
|
| 361 | (extra-special-file "/shared.txt"
|
| 362 | (plain-file "shared.txt" "hello"))
|
| 363 | (service oci-container-service-type
|
| 364 | (list
|
| 365 | (oci-container-configuration
|
| 366 | (image
|
| 367 | (oci-image
|
| 368 | (repository "guile")
|
| 369 | (value
|
| 370 | (specifications->manifest '("guile")))
|
| 371 | (pack-options
|
| 372 | '(#:symlinks (("/bin" -> "bin"))))))
|
| 373 | (entrypoint
|
| 374 | "/bin/guile")
|
| 375 | (command
|
| 376 | '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
|
| 377 | (host-environment
|
| 378 | '(("VARIABLE" . "value")))
|
| 379 | (volumes
|
| 380 | '(("/shared.txt" . "/shared.txt:ro")))
|
| 381 | (extra-arguments
|
| 382 | '("--env" "VARIABLE")))))))
|
| 383 |
|
| 384 | (define (run-oci-container-test)
|
| 385 | "Run IMAGE as an OCI backed Shepherd service, inside OS."
|
| 386 |
|
| 387 | (define os
|
| 388 | (marionette-operating-system
|
| 389 | (operating-system-with-gc-roots
|
| 390 | %oci-os
|
| 391 | (list))
|
| 392 | #:imported-modules '((gnu services herd)
|
| 393 | (guix combinators))))
|
| 394 |
|
| 395 | (define vm
|
| 396 | (virtual-machine
|
| 397 | (operating-system os)
|
| 398 | (volatile? #f)
|
| 399 | (memory-size 1024)
|
| 400 | (disk-image-size (* 3000 (expt 2 20)))
|
| 401 | (port-forwardings '())))
|
| 402 |
|
| 403 | (define test
|
| 404 | (with-imported-modules '((gnu build marionette))
|
| 405 | #~(begin
|
| 406 | (use-modules (srfi srfi-11) (srfi srfi-64)
|
| 407 | (gnu build marionette))
|
| 408 |
|
| 409 | (define marionette
|
| 410 | |
| 411 | |
| 412 | (make-marionette (list #$vm) #:timeout 60))
|
| 413 |
|
| 414 | (test-runner-current (system-test-runner #$output))
|
| 415 | (test-begin "oci-container")
|
| 416 |
|
| 417 | (wait-for-file "/run/containerd/containerd.pid" marionette)
|
| 418 |
|
| 419 | (test-assert "docker-guile running"
|
| 420 | (marionette-eval
|
| 421 | '(begin
|
| 422 | (use-modules (gnu services herd))
|
| 423 | (wait-for-service 'docker-guile #:timeout 120)
|
| 424 | #t)
|
| 425 | marionette))
|
| 426 |
|
| 427 | (test-assert "passing host environment variables and volumes"
|
| 428 | (begin
|
| 429 | (define (run-test)
|
| 430 | (marionette-eval
|
| 431 | `(begin
|
| 432 | (use-modules (ice-9 popen)
|
| 433 | (ice-9 rdelim))
|
| 434 |
|
| 435 | (define slurp
|
| 436 | (lambda args
|
| 437 | (let* ((port (apply open-pipe* OPEN_READ args))
|
| 438 | (output (let ((line (read-line port)))
|
| 439 | (if (eof-object? line)
|
| 440 | ""
|
| 441 | line)))
|
| 442 | (status (close-pipe port)))
|
| 443 | output)))
|
| 444 | (let* ((response1 (slurp
|
| 445 | ,(string-append #$docker-cli "/bin/docker")
|
| 446 | "exec" "docker-guile"
|
| 447 | "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
|
| 448 | (response2 (slurp
|
| 449 | ,(string-append #$docker-cli "/bin/docker")
|
| 450 | "exec" "docker-guile"
|
| 451 | "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
|
| 452 | (display (call-with-input-file \"/shared.txt\" read-line)))")))
|
| 453 | (list response1 response2)))
|
| 454 | marionette))
|
| 455 | |
| 456 | (let loop ((attempts 0))
|
| 457 | (if (= attempts 60)
|
| 458 | (error "Service didn't come up after more than 60 seconds")
|
| 459 | (if (equal? '("value" "hello")
|
| 460 | (run-test))
|
| 461 | #t
|
| 462 | (begin
|
| 463 | (sleep 1)
|
| 464 | (loop (+ 1 attempts))))))))
|
| 465 |
|
| 466 | (test-end))))
|
| 467 |
|
| 468 | (gexp->derivation "oci-container-test" test))
|
| 469 |
|
| 470 | (define %test-oci-container
|
| 471 | (system-test
|
| 472 | (name "oci-container")
|
| 473 | (description "Test OCI backed Shepherd service.")
|
| 474 | (value (run-oci-container-test))))
|