aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/docker.scm
blob: 9e9d2e2d07cd4e202bf8a160be3ea03e6ca870c8 (about) (plain) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
-rw-r--r--builtins.cc2484logplainabout
-rw-r--r--builtins.hh1504logplainabout
-rw-r--r--derivations.cc8427logplainabout
-rw-r--r--derivations.hh2456logplainabout
-rw-r--r--gc.cc25224logplainabout
-rw-r--r--globals.cc5894logplainabout
-rw-r--r--globals.hh6690logplainabout
-rw-r--r--local-store.cc51614logplainabout
-rw-r--r--local-store.hh8952logplainabout
-rw-r--r--misc.cc3016logplainabout
-rw-r--r--misc.hh1028logplainabout
-rw-r--r--optimise-store.cc8681logplainabout
-rw-r--r--pathlocks.cc5470logplainabout
-rw-r--r--pathlocks.hh944logplainabout
-rw-r--r--references.cc3429logplainabout
-rw-r--r--references.hh169logplainabout
-rw-r--r--sqlite.cc4000logplainabout
-rw-r--r--sqlite.hh2039logplainabout
-rw-r--r--store-api.cc7886logplainabout
-rw-r--r--store-api.hh12980logplainabout
-rw-r--r--worker-protocol.hh1495logplainabout
generated by cgit
nu services herd) (guix combinators)))) (define vm (virtual-machine (operating-system os) (volatile? #f) (memory-size 1024) (disk-image-size (* 3000 (expt 2 20))) (port-forwardings '()))) (define test (with-imported-modules '((gnu build marionette)) #~(begin (use-modules (srfi srfi-11) (srfi srfi-64) (gnu build marionette)) (define marionette ;; Relax timeout to accommodate older systems. (make-marionette (list #$vm) #:timeout 60)) (test-runner-current (system-test-runner #$output)) (test-begin "docker") (test-assert "service running" (marionette-eval '(begin (use-modules (gnu services herd)) (match (start-service 'dockerd) (#f #f) (('service response-parts ...) (match (assq-ref response-parts 'running) ((pid) (number? pid)))))) marionette)) (test-eq "fetch version" 0 (marionette-eval `(begin (system* ,(string-append #$docker-cli "/bin/docker") "version")) marionette)) (test-equal "Load docker image and run it" '("hello world" "hi!" "JSON!" #o1777) (marionette-eval `(begin (use-modules (ice-9 popen) (ice-9 rdelim)) (define slurp (lambda args (let* ((port (apply open-pipe* OPEN_READ args)) (output (read-line port)) (status (close-pipe port))) output))) (let* ((raw-line (slurp ,(string-append #$docker-cli "/bin/docker") "load" "-i" ,#$docker-tarball)) (repository&tag (string-drop raw-line (string-length "Loaded image: "))) (response1 (slurp ,(string-append #$docker-cli "/bin/docker") "run" "--entrypoint" "bin/Guile" repository&tag "/aa.scm")) (response2 (slurp ;default entry point ,(string-append #$docker-cli "/bin/docker") "run" repository&tag "-c" "(display \"hi!\")")) ;; Check whether (json) is in $GUILE_LOAD_PATH. (response3 (slurp ;default entry point + environment ,(string-append #$docker-cli "/bin/docker") "run" repository&tag "-c" "(use-modules (json)) (display (json-string->scm (scm->json-string \"JSON!\")))")) ;; Check whether /tmp exists. (response4 (slurp ,(string-append #$docker-cli "/bin/docker") "run" repository&tag "-c" "(display (stat:perms (lstat \"/tmp\")))"))) (list response1 response2 response3 (string->number response4)))) marionette)) (test-end)))) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) (mlet* %store-monad ((_ (set-grafting #f)) (guile (set-guile-for-build (default-guile))) (guest-script-package -> (package (name "guest-script") (version "0") (source #f) (build-system trivial-build-system) (arguments `(#:guile ,guile-3.0 #:builder (let ((out (assoc-ref %outputs "out"))) (mkdir out) (call-with-output-file (string-append out "/a.scm") (lambda (port) (display "(display \"hello world\n\")" port))) #t))) (synopsis "Display hello world using Guile") (description "This package displays the text \"hello world\" on the standard output device and then enters a new line.") (home-page #f) (license license:public-domain))) (profile (profile-derivation (packages->manifest (list guile-3.0 guile-json-3 guest-script-package)) #:hooks '() #:locales? #f)) (tarball (pack:docker-image "docker-pack" profile #:symlinks '(("/bin/Guile" -> "bin/guile") ("aa.scm" -> "a.scm")) #:entry-point "bin/guile" #:localstatedir? #t))) (run-docker-test tarball))) (define %test-docker (system-test (name "docker") (description "Test Docker container of Guix.") (value (build-tarball&run-docker-test)))) (define (run-docker-system-test tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system (operating-system-with-gc-roots %docker-os (list tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) (define vm (virtual-machine (operating-system os) (volatile? #f) (disk-image-size (* 6000 (expt 2 20))) (memory-size 2048) (port-forwardings '()))) (define test (with-imported-modules '((gnu build marionette) (guix build utils)) #~(begin (use-modules (srfi srfi-11) (srfi srfi-64) (gnu build marionette) (guix build utils)) (define marionette ;; Relax timeout to accommodate older systems. (make-marionette (list #$vm) #:timeout 60)) (test-runner-current (system-test-runner #$output)) (test-begin "docker") (test-assert "service running" (marionette-eval '(begin (use-modules (gnu services herd)) (match (start-service 'dockerd) (#f #f) (('service response-parts ...) (match (assq-ref response-parts 'running) ((pid) (number? pid)))))) marionette)) (test-assert "load system image and run it" (marionette-eval `(begin (use-modules (ice-9 popen) (ice-9 rdelim) (guix build utils)) (define (slurp command . args) ;; Return the output from COMMAND. (let* ((port (apply open-pipe* OPEN_READ command args)) (output (read-line port)) (status (close-pipe port))) output)) (define (docker-cli command . args) ;; Run the given Docker COMMAND. (apply invoke #$(file-append docker-cli "/bin/docker") command args)) (define (wait-for-container-file container file) ;; Wait for FILE to show up in CONTAINER. (docker-cli "exec" container #$(file-append guile-3.0 "/bin/guile") "-c" (object->string `(let loop ((n 15)) (when (zero? n) (error "file didn't show up" ,file)) (unless (file-exists? ,file) (sleep 1) (loop (- n 1))))))) (let* ((line (slurp #$(file-append docker-cli "/bin/docker") "load" "-i" #$tarball)) (repository&tag (string-drop line (string-length "Loaded image: "))) (container (slurp #$(file-append docker-cli "/bin/docker") "create" repository&tag))) (docker-cli "start" container) ;; Wait for shepherd to be ready. (wait-for-container-file container "/var/run/shepherd/socket") (docker-cli "exec" container "/run/current-system/profile/bin/herd" "status") (slurp #$(file-append docker-cli "/bin/docker") "exec" container "/run/current-system/profile/bin/herd" "status" "guix-daemon"))) marionette)) (test-end)))) (gexp->derivation "docker-system-test" test)) (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") (value (with-monad %store-monad (>>= (lower-object (system-image (os->image (operating-system (inherit (simple-operating-system)) ;; Use locales for a single libc to ;; reduce space requirements. (locale-libcs (list glibc))) #:type docker-image-type))) run-docker-system-test)))))
generated by cgit