diff options
Diffstat (limited to 'guix/docker.scm')
| -rw-r--r-- | guix/docker.scm | 23 |
1 files changed, 17 insertions, 6 deletions
diff --git a/guix/docker.scm b/guix/docker.scm index 060232148e..98914f1a13 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -28,7 +28,8 @@ #:use-module (srfi srfi-19) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) - #:export (build-docker-image)) + #:export (build-docker-image + raw-disk-image->docker-image)) ;; Load Guile-JSON at run time to simplify the job of 'imported-modules' & co. (module-use! (current-module) (resolve-interface '(json))) @@ -106,7 +107,9 @@ return \"a\"." #:key closure compressor (symlinks '()) (system (utsname:machine (uname))) - (creation-time (current-time time-utc))) + (creation-time (current-time time-utc)) + (tmpdir "/tmp") + extra-items-dir) "Write to IMAGE a Docker image archive from the given store PATH. The image contains the closure of PATH, as specified in CLOSURE (a file produced by #:references-graphs). SYMLINKS must be a list of (SOURCE -> TARGET) tuples @@ -116,7 +119,7 @@ binaries at PATH are for; it is used to produce metadata in the image. Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), to compress IMAGE. Use CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata." - (let ((directory "/tmp/docker-image") ;temporary working directory + (let ((directory (string-append tmpdir "/docker-image")) ;temporary working directory (closure (canonicalize-path closure)) (id (docker-id path)) (time (date->string (time-utc->date creation-time) "~4")) @@ -159,9 +162,14 @@ CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata." (append %tar-determinism-options items (map symlink-source symlinks)))) - (for-each delete-file-recursively - (map (compose topmost-component symlink-source) - symlinks))))) + (begin + (for-each delete-file-recursively + (map (compose topmost-component symlink-source) + symlinks)) + (zero? (apply system* "tar" "-C" extra-items-dir + "-rf" "layer.tar" + (append %tar-determinism-options + '(".")))))))) (with-output-to-file "config.json" (lambda () @@ -181,3 +189,6 @@ CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata." '()) "."))) (begin (delete-file-recursively directory) #t))))) + +(define* (raw-disk-image->docker-image raw-image) + (display "Doing the docker stuff!")) |