guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Building Docker images of GuixSD


From: Pjotr Prins
Subject: Re: Building Docker images of GuixSD
Date: Thu, 9 Nov 2017 07:43:26 +0100
User-agent: Mutt/1.5.21 (2010-09-15)

Chris, this is very interesting! Even with privileged mode it makes it
much easier to experiment. 

Pj.

On Wed, Nov 08, 2017 at 10:15:38PM -0800, Chris Marusich wrote:
> Hi Ludo and others following along,
> 
> I've run GuixSD in a Docker container and returned to tell the tale!
> The attached patch requires a lot of cleaning up (e.g., proper ChangeLog
> entry, update documentation, remove some unnecessary imports and debug
> messages that are probably still in there), so I'm taking a moment to
> share my results and ask for feedback before committing to spending more
> time on this.
> 
> Run GuixSD in Docker
> ====================
> 
> The attached patch makes it possible to build a GuixSD Docker image from
> an operating system configuration file.
> 
> You can build your own like this:
> 
> 1) Apply this patch to 3b2fa4787938a408fab27ef7b3bc1302b6b6a805.
> 
> 2) Build an image (I used the attached file "very-bare-bones.scm"):
> 
>     ./pre-inst-env guix system disk-image -t docker very-bare-bones.scm
> 
> 3) Copy the resulting image onto a host that has Docker installed.
> 
> 4) On the host with Docker, load the image and note the image ID:
> 
>     docker load < pw3d4r4m1x9yc3d1kg9x3y6abdzq9z7g-docker-image.tar.gz
> 
> 5) Run a Docker container from the image, and note the container ID:
> 
>     docker run --privileged -d -e GUIX_NEW_SYSTEM=/var/guix/profiles/system 
> --net host --entrypoint /var/guix/profiles/system/profile/bin/guile 
> dcaa8fb677c7 /var/guix/profiles/system/boot
> 
> 6) Run a shell in the container, install a package, and use it:
> 
>     docker exec -it -e USER=alice -u alice fb06fdcd3a0d 
> /run/current-system/profile/bin/bash --login
> 
> 7) Install a package and use it:
> 
>     address@hidden /$ guix package -i hello
>     ...
>     Creating manual page database for 1 packages... done in 0.110 s
>     1 package in profile
>     address@hidden /$ guix package --list-installed
>     hello     2.10    out     
> /gnu/store/wf65hjwqwpz4wllasn63zysi5irql2sx-hello-2.10
>     address@hidden /$ hello
>     Hello, world!
> 
> Pretty neat!
> 
> How Useful Is This?
> ===================
> 
> Using Guix, it was already possible to generate Docker images using
> "guix pack".  For example, I could have just generated a Docker image
> from the GNU Hello package, created a container from that, and then run
> "hello" from that container.  What does running GuixSD in Docker give us
> that we don't have already?  At a minimum, it gives us the following:
> 
> * The ability to define what service(s) should run in the resulting
>   Docker container, including their configs and start/stop scripts.
>   
> * Since the Docker image is generated from a GuixSD operating system
>   configuration file, the rules for defining and configuring services
>   are the same as always.  You don't have to learn anything new.
> 
> * If you want to run Guix on a system to which Guix hasn't been ported
>   (like macOS) but your system does run Docker, now you can run Guix on
>   that system by running it from a GuixSD Docker container.
> 
> Is this helpful?  Is it worth polishing up and maintaining?  I'm not
> entirely sure, and I'd like to know what you think.
> 
> For the first two bullet points, that's nice, but instead of using a
> full-blown OS and relying on the Shepherd for process management in this
> case, would it be simpler to just provide a way to easily bundle
> start/stop scripts inside of the packs produced by "guix pack"?  An
> enterprising user can probably do this today by simply defining a
> package that builds start/stop scripts for a given service; the user
> would then just need to include that package in the pack.  The downside,
> I guess, is that you can't re-use the service-specific stuff that you
> can normally use in a GuixSD operating system configuration file.
> 
> For the third bullet point, I don't know of any other reasonable way to
> get Guix working in Docker (although one could certainly run Guix in a
> VM using a technology other than Docker, such as QEMU).  To run Guix,
> you need the Guix daemon running somewhere, right?  And the Guix daemon
> requires that certain build users exist.  It might require other things
> from its environment, too.  In any case, you can't just run "guix pack
> -t docker guix" and expect the "guix" command to work in the container
> (I tried, and it doesn't work).  You have to take additional measures,
> like create build users, at which point it seems easier to just put all
> of GuixSD into a Docker image.  That's what my patch lets you do.
> 
> What do you think?  Is this worth polishing up and maintaining?
> 
> Problems I Noticed
> ==================
> 
> Now I'll mention some specific problems I've noticed while running
> GuixSD in a Docker container.  First, I saw this while the Docker image
> was being generated:
> 
>     tar: Removing leading `/' from member names
>     tar: Removing leading `/' from hard link targets
>     tar: ./dev/log: socket ignored
> 
> It's fine that we remove the leading '/' from member names, since it
> looks like the tarball will be extracted relative to '/'.  I think the
> same is true for the hard link targets.  However, because tar ignored
> '/dev/log', that socket is missing in the Docker image.  I don't know if
> that will interfere with syslogd, but it sure doesn't sound good.
> 
> Second, I noticed the following error in the Guix daemon's logs.  It
> might be benign, since package installation worked fine, but I'm not
> sure what it means or how to debug it:
> 
>     error in finalization thread: Bad file descriptor
> 
> Third, I noticed that the shepherd failed to start syslogd and nscd (and
> user-homes, although I wasn't as concerned about that because the home
> directory for alice did in fact get created).  I understand that, due to
> the way Docker works, some services are either not required (like
> networking) or might require modifications to "behave well" in a Docker
> container.  However, I didn't think syslogd and nscd would fall into
> either of those categories, so I was surprised that they failed to
> start.  The only relevant debug information appears to be the following
> messages in the Shepherd logs (/var/log):
> 
>     2017-11-09 06:41:27 Service user-homes could not be started.
>     2017-11-09 06:41:32 Service nscd could not be started.
>     2017-11-09 06:41:37 Service syslogd could not be started.
> 
> I thought maybe syslogd wasn't working because /dev/log hadn't been
> created in the Docker image, so I tried creating it manually.  However,
> that didn't help; the Shepherd still couldn't start syslogd.
> 
> Fourth, I wasn't able to run GuixSD in a Docker container without
> supplying the "--privileged" option.  GuixSD writes to sysfs during boot
> (I don't know why, but the details are apparently in
> guix/gnu/build/activation.scm), so the only way to get GuixSD to start
> is to run the container in privileged mode.  This is unfortunate,
> because privileged mode sounds quite dangerous for a lot of reasons.
> For example, if both GuixSD in the Docker container and the host
> operating system attempt to control the underlying hardware at the same
> time, bad things might happen.
> 
> Thanks for reading this far.  I look forward to hearing your thoughts!
> 
> -- 
> Chris

> From 25d5527b14302fc835af5c338bf37cf621c63a4e Mon Sep 17 00:00:00 2001
> From: Chris Marusich <address@hidden>
> Date: Sat, 21 Oct 2017 14:40:58 -0700
> Subject: [PATCH] Make it possible to build GuixSD docker images
> 
> ---
>  gnu/build/linux-boot.scm    |   5 +-
>  gnu/build/vm.scm            |  14 ++--
>  gnu/system/linux-initrd.scm |  12 ++--
>  gnu/system/vm.scm           | 169 
> ++++++++++++++++++++++++++++++++++++++------
>  guix/docker.scm             |  23 ++++--
>  guix/scripts/pack.scm       |   5 +-
>  guix/scripts/system.scm     |   3 +-
>  7 files changed, 191 insertions(+), 40 deletions(-)
> 
> diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
> index 3712abe91..37da5b217 100644
> --- a/gnu/build/linux-boot.scm
> +++ b/gnu/build/linux-boot.scm
> @@ -117,8 +117,9 @@ with the given MAJOR number, starting with MINOR."
>                         "/")
>                     dir))
>  
> +  (display "just before dev\n")
>    (unless (file-exists? (scope "dev"))
> -    (mkdir (scope "dev")))
> +    (mkdir (pk (scope "dev"))))
>  
>    ;; Make the device nodes for SCSI disks.
>    (make-disk-device-nodes (scope "dev/sda") 8)
> @@ -138,6 +139,7 @@ with the given MAJOR number, starting with MINOR."
>    (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2))
>  
>    ;; Inputs (used by Xorg.)
> +  (display "just before dev/input\n")
>    (unless (file-exists? (scope "dev/input"))
>      (mkdir (scope "dev/input")))
>    (mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63))
> @@ -171,6 +173,7 @@ with the given MAJOR number, starting with MINOR."
>    (chmod (scope "dev/ptmx") #o666)
>  
>    ;; Create /dev/pts; it will be mounted later, at boot time.
> +  (display "just before dev/pts\n")
>    (unless (file-exists? (scope "dev/pts"))
>      (mkdir (scope "dev/pts")))
>  
> diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
> index 7537f8150..19c47e1ff 100644
> --- a/gnu/build/vm.scm
> +++ b/gnu/build/vm.scm
> @@ -294,11 +294,14 @@ it, run its initializer, and unmount it."
>  (define* (root-partition-initializer #:key (closures '())
>                                       copy-closures?
>                                       (register-closures? #t)
> -                                     system-directory)
> +                                     system-directory
> +                                     (deduplicate? #t))
>    "Return a procedure to initialize a root partition.
>  
> -If REGISTER-CLOSURES? is true, register all of CLOSURES is the partition's
> -store.  If COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
> +If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's
> +store.  If DEDUPLICATE? is true, then also deduplicate files common to
> +CLOSURES and the rest of the store when registering the closures.  If
> +COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
>  SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
>    (lambda (target)
>      (define target-store
> @@ -317,13 +320,16 @@ SYSTEM-DIRECTORY is the name of the directory of the 
> 'system' derivation."
>        (unless copy-closures?
>          ;; XXX: 'guix-register' wants to palpate the things it registers, so
>          ;; bind-mount the store on the target.
> +        (display "making target store directory\n")
>          (mkdir-p target-store)
> +        (display "bind-mounting\n")
>          (mount (%store-directory) target-store "" MS_BIND))
>  
>        (display "registering closures...\n")
>        (for-each (lambda (closure)
>                    (register-closure target
> -                                    (string-append "/xchg/" closure)))
> +                                    (string-append "/xchg/" closure)
> +                                    #:deduplicate? deduplicate?))
>                  closures)
>        (unless copy-closures?
>          (umount target-store)))
> diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
> index 948c543a1..698f0aa70 100644
> --- a/gnu/system/linux-initrd.scm
> +++ b/gnu/system/linux-initrd.scm
> @@ -155,7 +155,8 @@ MODULES and taken from LINUX."
>                        (mapped-devices '())
>                        (helper-packages '())
>                        qemu-networking?
> -                      volatile-root?)
> +                      volatile-root?
> +                      (guile %guile-static-stripped))
>    "Return a monadic derivation that builds a raw initrd, with kernel
>  modules taken from LINUX.  FILE-SYSTEMS is a list of file-systems to be
>  mounted by the initrd, possibly in addition to the root file system specified
> @@ -217,7 +218,8 @@ to it are lost."
>                        #:linux-module-directory '#$kodir
>                        #:qemu-guest-networking? #$qemu-networking?
>                        #:volatile-root? '#$volatile-root?)))
> -   #:name "raw-initrd"))
> +   #:name "raw-initrd"
> +   #:guile guile))
>  
>  (define* (file-system-packages file-systems #:key (volatile-root? #f))
>    "Return the list of statically-linked, stripped packages to check
> @@ -246,7 +248,8 @@ FILE-SYSTEMS."
>                        qemu-networking?
>                        volatile-root?
>                        (virtio? #t)
> -                      (extra-modules '()))
> +                      (extra-modules '())
> +                      (guile %guile-static-stripped))
>    "Return a monadic derivation that builds a generic initrd, with kernel
>  modules taken from LINUX.  FILE-SYSTEMS is a list of file-systems to be
>  mounted by the initrd, possibly in addition to the root file system specified
> @@ -321,6 +324,7 @@ loaded at boot time in the order in which they appear."
>                #:mapped-devices mapped-devices
>                #:helper-packages helper-packages
>                #:qemu-networking? qemu-networking?
> -              #:volatile-root? volatile-root?))
> +              #:volatile-root? volatile-root?
> +              #:guile guile))
>  
>  ;;; linux-initrd.scm ends here
> diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
> index 3127b305e..b48a9a962 100644
> --- a/gnu/system/vm.scm
> +++ b/gnu/system/vm.scm
> @@ -22,6 +22,7 @@
>  
>  (define-module (gnu system vm)
>    #:use-module (guix config)
> +  #:use-module (guix docker)
>    #:use-module (guix store)
>    #:use-module (guix gexp)
>    #:use-module (guix derivations)
> @@ -29,13 +30,16 @@
>    #:use-module (guix monads)
>    #:use-module (guix records)
>    #:use-module (guix modules)
> +  #:use-module (guix scripts pack)
>  
>    #:use-module ((gnu build vm)
>                  #:select (qemu-command))
>    #:use-module (gnu packages base)
> +
>    #:use-module (gnu packages bootloaders)
>    #:use-module (gnu packages cdrom)
>    #:use-module (gnu packages guile)
> +  #:autoload   (gnu packages gnupg) (libgcrypt)
>    #:use-module (gnu packages gawk)
>    #:use-module (gnu packages bash)
>    #:use-module (gnu packages less)
> @@ -116,7 +120,8 @@
>                                               (references-graphs #f)
>                                               (memory-size 256)
>                                               (disk-image-format "qcow2")
> -                                             (disk-image-size 'guess))
> +                                             (disk-image-size 'guess)
> +                                             (guile-for-initrd 
> %guile-static-stripped))
>    "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
>  derivation).  The virtual machine runs with MEMORY-SIZE MiB of memory.  In 
> the
>  virtual machine, EXP has access to all its inputs from the store; it should
> @@ -143,7 +148,8 @@ made available under the /xchg CIFS share."
>                           (base-initrd %linux-vm-file-systems
>                                        #:linux linux
>                                        #:virtio? #t
> -                                      #:qemu-networking? #t))))
> +                                      #:qemu-networking? #t
> +                                      #:guile guile-for-initrd))))
>  
>      (define builder
>        ;; Code that launches the VM that evaluates EXP.
> @@ -349,6 +355,117 @@ the image."
>     #:disk-image-format disk-image-format
>     #:references-graphs inputs))
>  
> +(define* (os-docker-image #:key
> +                          (name "guixsd-docker-image")
> +                          os-drv
> +                          (system (%current-system))
> +                          (compressor (first %compressors))
> +                          localstatedir?
> +                          (symlinks '())
> +                          (tar tar)
> +                          (register-closures? #t))
> +  "Build a docker image.  OS-DRV is a derivation which builds the
> +operating system profile."
> +  ;; FIXME: Honor LOCALSTATEDIR?.
> +  (define not-config?
> +    (match-lambda
> +      (('guix 'config) #f)
> +      (('guix rest ...) #t)
> +      (('gnu rest ...) #t)
> +      (rest #f)))
> +
> +  (define config
> +    ;; (guix config) module for consumption by (guix gcrypt).
> +    (scheme-file "gcrypt-config.scm"
> +                 #~(begin
> +                     (define-module (guix config)
> +                       #:export (%libgcrypt))
> +
> +                     ;; XXX: Work around <http://bugs.gnu.org/15602>.
> +                     (eval-when (expand load eval)
> +                       (define %libgcrypt
> +                         #+(file-append libgcrypt "/lib/libgcrypt"))))))
> +
> +  (define json
> +    ;; Pick the guile-json package that corresponds to the Guile used to 
> build
> +    ;; derivations.
> +    (if (string-prefix? "2.0" (package-version (default-guile)))
> +        guile2.0-json
> +        guile-json))
> +  
> +  (let ((name (string-append name ".tar" (compressor-extension compressor)))
> +        (system-graph-name "system"))
> +    (define build
> +      (with-imported-modules `(,@(source-module-closure '((guix docker)
> +                                                          (gnu build vm)
> +                                                          (guix build utils)
> +                                                          (guix build 
> syscalls))
> +                                                        #:select? 
> not-config?)
> +                               ((guix config) => ,config))
> +        #~(begin
> +            ;; Guile-JSON is required by (guix docker).
> +            (add-to-load-path
> +             (string-append #+json "/share/guile/site/"
> +                            (effective-version)))
> +            (use-modules (gnu build vm)
> +                         (guix build utils)
> +                         (guix build syscalls)
> +                         (srfi srfi-26)
> +                         (ice-9 match)
> +                         (guix docker)
> +                         (srfi srfi-19))
> +
> +            (let* ((inputs
> +                    '#$(append (list tree parted e2fsprogs dosfstools tar)
> +                               (map canonical-package
> +                                    (list sed grep coreutils findutils gawk))
> +                               (if register-closures? (list guix) '())))
> +
> +                   ;; This variable is unused but allows us to add 
> INPUTS-TO-COPY
> +                   ;; as inputs.
> +                   (to-register '#$os-drv)
> +                   (initialize (root-partition-initializer
> +                                #:closures '(#$system-graph-name)
> +                                #:copy-closures? #f
> +                                #:register-closures? #$register-closures?
> +                                #:system-directory #$os-drv
> +                                #:deduplicate? #f))
> +                   (root "/tmp/root"))
> +
> +              (display "before set path\n")
> +              (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
> +              (system* "id")
> +              (display "before initializing root\n")
> +              (system* "df")
> +              (mkdir-p root)
> +              (initialize root)
> +              (display "after initializing root, building docker image\n")
> +              ;; Use a temporary directory inside xchg to avoid hitting space
> +              ;; limitations in the initrd's root file system.
> +              (let ((tmpdir "/xchg/tmp"))
> +                (mkdir tmpdir)
> +                ;; TODO: Put paths from outside of the store into the docker 
> image.
> +                ;; For example, /var/guix, /home, etc.
> +                (build-docker-image
> +                 (string-append "/xchg/" #$name) ;; The output file.
> +                 #$os-drv
> +                 #:closure (string-append "/xchg/" #$system-graph-name)
> +                 #:symlinks '#$symlinks
> +                 #:compressor '#$(compressor-command compressor)
> +                 #:creation-time (make-time time-utc 0 1)
> +                 #:tmpdir tmpdir
> +                 #:extra-items-dir root)
> +                (delete-file-recursively tmpdir))))))
> +    (expression->derivation-in-linux-vm
> +     name
> +     build
> +     #:system system
> +     #:make-disk-image? #f
> +     #:single-file-output? #t
> +     #:references-graphs `((,system-graph-name ,os-drv))
> +     #:guile-for-initrd guile-2.2
> +     #:memory-size 512)))
> +
> 
>  ;;;
>  ;;; VM and disk images.
> @@ -443,31 +560,37 @@ to USB sticks meant to be read-only."
>  
>      (mlet* %store-monad ((os-drv   (operating-system-derivation os))
>                           (bootcfg  (operating-system-bootcfg os)))
> -      (if (string=? "iso9660" file-system-type)
> -          (iso9660-image #:name name
> -                         #:file-system-label root-label
> -                         #:file-system-uuid root-uuid
> +      (cond ((string=? "iso9660" file-system-type)
> +             (iso9660-image #:name name
> +                            #:file-system-label root-label
> +                            #:file-system-uuid root-uuid
> +                            #:os-drv os-drv
> +                            #:register-closures? #t
> +                            #:bootcfg-drv bootcfg
> +                            #:bootloader (bootloader-configuration-bootloader
> +                                           (operating-system-bootloader os))
> +                            #:inputs `(("system" ,os-drv)
> +                                       ("bootcfg" ,bootcfg))))
> +            ((string=? "docker" file-system-type)
> +             (display "made it to docker image part\n")
> +             (os-docker-image #:name name
> +                              #:os-drv os-drv
> +                              #:register-closures? #t))
> +            (else
> +             (qemu-image #:name name
>                           #:os-drv os-drv
> -                         #:register-closures? #t
>                           #:bootcfg-drv bootcfg
>                           #:bootloader (bootloader-configuration-bootloader
> -                                        (operating-system-bootloader os))
> +                                       (operating-system-bootloader os))
> +                         #:disk-image-size disk-image-size
> +                         #:disk-image-format "raw"
> +                         #:file-system-type file-system-type
> +                         #:file-system-label root-label
> +                         #:file-system-uuid root-uuid
> +                         #:copy-inputs? #t
> +                         #:register-closures? #t
>                           #:inputs `(("system" ,os-drv)
> -                                    ("bootcfg" ,bootcfg)))
> -          (qemu-image #:name name
> -                      #:os-drv os-drv
> -                      #:bootcfg-drv bootcfg
> -                      #:bootloader (bootloader-configuration-bootloader
> -                                    (operating-system-bootloader os))
> -                      #:disk-image-size disk-image-size
> -                      #:disk-image-format "raw"
> -                      #:file-system-type file-system-type
> -                      #:file-system-label root-label
> -                      #:file-system-uuid root-uuid
> -                      #:copy-inputs? #t
> -                      #:register-closures? #t
> -                      #:inputs `(("system" ,os-drv)
> -                                 ("bootcfg" ,bootcfg)))))))
> +                                    ("bootcfg" ,bootcfg))))))))
>  
>  (define* (system-qemu-image os
>                              #:key
> diff --git a/guix/docker.scm b/guix/docker.scm
> index 060232148..98914f1a1 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!"))
> diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
> index 21fea446a..8d8053fca 100644
> --- a/guix/scripts/pack.scm
> +++ b/guix/scripts/pack.scm
> @@ -41,7 +41,10 @@
>    #:use-module (srfi srfi-9)
>    #:use-module (srfi srfi-37)
>    #:use-module (ice-9 match)
> -  #:export (compressor?
> +  #:export (%compressors
> +            compressor-extension
> +            compressor-command
> +            compressor?
>              lookup-compressor
>              self-contained-tarball
>              guix-pack))
> diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
> index e50f1d8ac..a319692d7 100644
> --- a/guix/scripts/system.scm
> +++ b/guix/scripts/system.scm
> @@ -638,8 +638,9 @@ any, are available.  Raise an error if they're not."
>                                              #:mappings mappings))
>      ((disk-image)
>       (system-disk-image os
> -                        #:name (match file-system-type
> +                        #:name (match (pk file-system-type)
>                                   ("iso9660" "image.iso")
> +                                 ("docker" "docker-image")
>                                   (_         "disk-image"))
>                          #:disk-image-size image-size
>                          #:file-system-type file-system-type))))
> -- 
> 2.14.2
> 





-- 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]