[bug#30572] [PATCH 0/7] Add "guix system docker-image" command

[bug#30572] [PATCH 0/7] Add "guix system docker-image" command

[Chris Marusich]

Hi,

This patch series adds a new command: "guix system docker-image".  I
have the following questions for reviewers:

* In raw-initrd and base-initrd (gnu/system/linux-initrd.scm), why is
  %guile-static-stripped the right Guile to use by default?

* Instead of passing a Guile package to raw-initrd and base-initrd,
  would it be better to use a parameter (e.g., %guile-for-initrd),
  like we do for %guile-for-build?

* In system-docker-image (gnu/system/vm.scm), why is it necessary to
  define a custom (guix config) module?  I copied some of the logic
  from docker-image (guix/scripts/pack.scm), and it works, but I do
  not understand this part.

* Similarly, in gnu/system/vm.scm, why do we autoload libgcrypt?  I do
  not understand why we cannot simply #:use-module (gnu packages
  gnupg) like we do with all the other modules here.

* Similarly, in gnu/system/vm.scm, why do we use (ungexp-native json)?
  In the code, this is #+json and it occurs close to the comment
  "Guile-JSON is required by (guix docker)."

* Similarly, in gnu/system/vm.scm, there is a vestigial comment which
  says "This variable is unused but allows us to add INPUTS-TO-COPY as
  inputs" - this comment actually occurs in multiple places, not just
  the code I've added.  I think it refers to a variable that no longer
  exists, and I think that my variable to-register serves the intended
  purpose now, which is: add os-drv's inputs to the inputs of the gexp
  I'm building, so that they will be available on the build side.  So
  I'm thinking maybe we should just change this comment to say
  something more like that.  WDYT?

I have verified that this change builds and its tests pass.  I am
using it to run my very own Docker image today.  I hope you find it
useful, too!

Chris Marusich (7):
  tests: Add tests for "guix pack".
  vm: Allow control of deduplication in root-partition-initializer.
  system: Allow customization of the initrd's Guile.
  docker: Allow the use of a custom temporary directory.
  docker: Allow the addition of extra files into the image.
  system: Add "guix system docker-image" command.
  tests: Add tests for "guix system disk-image" et al.

 Makefile.am                           |   1 +
 doc/guix.texi                         |  74 ++++++++++++++++------
 gnu/build/vm.scm                      |  12 ++--
 gnu/system/examples/docker-image.tmpl |  47 ++++++++++++++
 gnu/system/linux-initrd.scm           |  31 ++++++---
 gnu/system/vm.scm                     | 116 ++++++++++++++++++++++++++++++++++
 guix/docker.scm                       |  29 +++++++--
 guix/scripts/system.scm               |  10 ++-
 tests/guix-pack.sh                    |  43 +++++++++++++
 tests/guix-system.sh                  |  13 ++++
 10 files changed, 333 insertions(+), 43 deletions(-)
 create mode 100644 gnu/system/examples/docker-image.tmpl
 create mode 100644 tests/guix-pack.sh

-- 
2.15.1

[bug#30572] [PATCH 0/7] Add "guix system docker-image" command (v2)

[Chris Marusich]

Hi Danny and Ludo,

Thank you for the feedback!  Please find attached a new patch series,
which incorporates all the feedback I've received so far.  I've verified
the following:

* This new patch series applies cleanly to b4bf9516.

* For every patch in this new series, "make" succeeds and "make check"
  succeeds for the relevant tests: guix-system.sh, guix-pack.sh (when it
  exists), pack.scm, and system.scm.

* After applying all patches, there are no new test failures for both
  "make check" and "make check-system"; the tests which passed before
  continue to pass.  However, note that there are some existing
  unrelated failures for both targets as of commit b4bf9516.  I will
  open a bug report for those unrelated failures shortly.

* I built a GuixSD Docker image from the example file docker-image.tmpl,
  loaded it into Docker on another machine, and successfully installed
  and ran GNU Hello via Guix in the Docker container.

Some notable differences from the first patch series are as follows:

* There is no longer any need to modify base-initrd or raw-initrd.  To
  work around the dlopen problem, we use a workaround like the one Ludo
  suggested.

* The --bootstrap option (and tests) for "guix pack" are improved.  The
  new option will cause "guix pack" to use not just the bootstrap Guile,
  but also the bootstrap tar and xz.

* When building in a VM, share a temporary directory by default.  This
  solves the problem of limited space in /tmp in the VM.

* Rewrite build-docker-image significantly to allow adding more paths.

The rest is largely the same.  Please let me know what you think.  I
still have the following questions from my original email:

* In system-docker-image (gnu/system/vm.scm), why is it necessary to
  define a custom (guix config) module?  I copied some of the logic
  from docker-image (guix/scripts/pack.scm), and it works, but I do
  not understand this part.

* Similarly, in gnu/system/vm.scm, why do we autoload libgcrypt?  I do
  not understand why we cannot simply #:use-module (gnu packages
  gnupg) like we do with all the other modules here.  Is it just for
  improved performance?

* Similarly, in gnu/system/vm.scm, why do we use (ungexp-native json)?
  In the code, this is #+json and it occurs close to the comment
  "Guile-JSON is required by (guix docker)."  It seems to me like we
  often mix the use of ugexp and ungexp-native for no apparent reason,
  and that in many cases it doesn't matter which one we use.

If anyone can answer those questions, I'd really appreciate it!

Chris Marusich (7):
  gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.
  tests: Add tests for "guix pack".
  vm: Allow control of deduplication in root-partition-initializer.
  gnu: When building in a VM, share a temporary directory.
  guix: Rewrite build-docker-image to allow more paths.
  system: Add "guix system docker-image" command.
  tests: Add tests for "guix system disk-image" et al.

 Makefile.am                           |   1 +
 doc/guix.texi                         |  42 ++++++-
 gnu/build/vm.scm                      |  20 +++-
 gnu/packages/bootstrap.scm            |  34 ++++++
 gnu/packages/package-management.scm   |   2 +
 gnu/system/examples/docker-image.tmpl |  47 ++++++++
 gnu/system/vm.scm                     | 125 ++++++++++++++++++++-
 guix/docker.scm                       | 200 +++++++++++++++++++++-------------
 guix/scripts/pack.scm                 |  70 ++++++++----
 guix/scripts/system.scm               |  12 +-
 tests/guix-pack.sh                    |  74 +++++++++++++
 tests/guix-system.sh                  |  17 +++
 12 files changed, 531 insertions(+), 113 deletions(-)
 create mode 100644 gnu/system/examples/docker-image.tmpl
 create mode 100644 tests/guix-pack.sh

-- 
2.15.1

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Chris Marusich]

* gnu/packages/bootstrap.scm (bootstrap-binary): New procedure.
  (%bootstrap-bash, %bootstrap-mkdir, %bootstrap-tar, %bootstrap-xz):
  Use it to create these new packages, and export them.
---
 gnu/packages/bootstrap.scm | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index 27f2053c4..fff294971 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,6 +44,10 @@
             bootstrap-guile-origin
 
             %bootstrap-guile
+            %bootstrap-bash
+            %bootstrap-mkdir
+            %bootstrap-tar
+            %bootstrap-xz
             %bootstrap-coreutils&co
             %bootstrap-binutils
             %bootstrap-gcc
@@ -345,6 +350,35 @@ $out/bin/guile --version~%"
      (home-page #f)
      (license lgpl3+))))
 
+(define (bootstrap-binary program-name)
+  (package
+    (name (string-append program-name "-bootstrap"))
+    ;; The version may differ depending on the program.
+    (version "unknown")
+    (source #f)
+    (build-system trivial-build-system)
+    (arguments
+     `(#:guile ,%bootstrap-guile
+       #:builder (let ((out (assoc-ref %outputs "out"))
+                       (program (assoc-ref %build-inputs ,program-name)))
+                   (mkdir out)
+                   (mkdir (string-append out "/bin"))
+                   (symlink program (string-append out "/bin/" ,program-name)))))
+    (inputs `((,program-name ,(search-bootstrap-binary program-name (%current-system)))))
+    (description (string-append "The bootstrap " program-name "."))
+    (synopsis (string-append "The bootstrap " program-name "."))
+    (license gpl3+)
+    (home-page #f)))
+
+;; These trivial packages provide individual binaries that are also included
+;; in %bootstrap-coreutils&co.  However, these packages are more minimal than
+;; %bootstrap-coreutils&co, and they do not require network access to build
+;; because these specific binaries are included in the Guix source tree.
+(define %bootstrap-bash (bootstrap-binary "bash"))
+(define %bootstrap-mkdir (bootstrap-binary "mkdir"))
+(define %bootstrap-tar (bootstrap-binary "tar"))
+(define %bootstrap-xz (bootstrap-binary "xz"))
+
 (define %bootstrap-coreutils&co
   (package-from-tarball "bootstrap-binaries"
                         (lambda (system)
-- 
2.15.1

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Chris Marusich]

* guix/scripts/pack.scm (%compressors) <bootstrap-xz>: New compressor.
  (%options) <--bootstrap>: New option.
  (show-help): Document the new --bootstrap option.
  (guix-pack): When --bootstrap is specified, use the bootstrap Guile,
  tar, and xz to build the pack, and do not use any profile hooks or
  locales.
* doc/guix.texi (Invoking guix pull): Document the new --bootstrap
  option.
* tests/guix-pack.sh: New file.
* Makefile.am (SH_TESTS): Add guix-pack.sh.
* gnu/packages/package-management.scm (guix) <inputs>: Add util-linux.
---
 Makefile.am                         |  1 +
 doc/guix.texi                       |  6 ++-
 gnu/packages/package-management.scm |  2 +
 guix/scripts/pack.scm               | 61 +++++++++++++++++++++---------
 tests/guix-pack.sh                  | 74 +++++++++++++++++++++++++++++++++++++
 5 files changed, 126 insertions(+), 18 deletions(-)
 create mode 100644 tests/guix-pack.sh

diff --git a/Makefile.am b/Makefile.am
index 6556799e6..637c934ed 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -374,6 +374,7 @@ SH_TESTS =					\
   tests/guix-download.sh			\
   tests/guix-gc.sh				\
   tests/guix-hash.sh				\
+  tests/guix-pack.sh				\
   tests/guix-package.sh				\
   tests/guix-package-net.sh			\
   tests/guix-system.sh				\
diff --git a/doc/guix.texi b/doc/guix.texi
index d3a7908f9..792539a12 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23,7 +23,7 @@ Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
 Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@*
 Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@*
 Copyright @copyright{} 2016 Ben Woodcroft@*
-Copyright @copyright{} 2016, 2017 Chris Marusich@*
+Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@*
 Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@*
 Copyright @copyright{} 2016 John Darrington@*
 Copyright @copyright{} 2016, 2017 ng0@*
@@ -2899,6 +2899,10 @@ added to it or removed from it after extraction of the pack.
 
 One use case for this is the Guix self-contained binary tarball
 (@pxref{Binary Installation}).
+
+@item --bootstrap
+Use the bootstrap binaries to build the pack.  This option is only
+useful to Guix developers.
 @end table
 
 In addition, @command{guix pack} supports all the common build options
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 709cdfd0f..a90ba7a21 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -257,6 +257,8 @@
          ;; Many tests rely on the 'guile-bootstrap' package, which is why we
          ;; have it here.
          ("boot-guile" ,(bootstrap-guile-origin (%current-system)))
+         ;; Some of the tests use "unshare" when it is available.
+         ("util-linux" ,util-linux)
          ,@(if (and (not (%current-target-system))
                     (string=? (%current-system) "x86_64-linux"))
                `(("boot-guile/i686" ,(bootstrap-guile-origin "i686-linux")))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 59dd117ed..64ed44460 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,7 +34,9 @@
   #:use-module (guix derivations)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
+  #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages guile)
   #:autoload   (gnu packages base) (tar)
   #:autoload   (gnu packages package-management) (guix)
   #:autoload   (gnu packages gnupg) (libgcrypt)
@@ -63,6 +66,8 @@
                     #~(#+(file-append lzip "/bin/lzip") "-9"))
         (compressor "xz"    ".xz"
                     #~(#+(file-append xz "/bin/xz") "-e -T0"))
+        (compressor "bootstrap-xz" ".xz"
+                    #~(#+(file-append %bootstrap-xz "/bin/xz") "-e -T0"))
         (compressor "bzip2" ".bz2"
                     #~(#+(file-append bzip2 "/bin/bzip2") "-9"))
         (compressor "none" "" #f)))
@@ -325,6 +330,9 @@ the image."
          (option '("localstatedir") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'localstatedir? #t result)))
+         (option '("bootstrap") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'bootstrap? #t result)))
 
          (append %transformation-options
                  %standard-build-options)))
@@ -352,6 +360,8 @@ Create a bundle of PACKAGE.\n"))
   -m, --manifest=FILE    create a pack with the manifest from FILE"))
   (display (G_ "
       --localstatedir    include /var/guix in the resulting pack"))
+  (display (G_ "
+      --bootstrap        use the bootstrap binaries to build the pack"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -393,28 +403,43 @@ Create a bundle of PACKAGE.\n"))
        (else (packages->manifest packages)))))
 
   (with-error-handling
-    (parameterize ((%graft? (assoc-ref opts 'graft?)))
-      (let* ((dry-run?    (assoc-ref opts 'dry-run?))
-             (manifest    (manifest-from-args opts))
-             (pack-format (assoc-ref opts 'format))
-             (name        (string-append (symbol->string pack-format)
-                                         "-pack"))
-             (target      (assoc-ref opts 'target))
-             (compressor  (assoc-ref opts 'compressor))
-             (symlinks    (assoc-ref opts 'symlinks))
-             (build-image (match (assq-ref %formats pack-format)
-                            ((? procedure? proc) proc)
-                            (#f
-                             (leave (G_ "~a: unknown pack format")
-                                    format))))
-             (localstatedir? (assoc-ref opts 'localstatedir?)))
-        (with-store store
+    (let* ((dry-run?    (assoc-ref opts 'dry-run?))
+           (manifest    (manifest-from-args opts))
+           (pack-format (assoc-ref opts 'format))
+           (name        (string-append (symbol->string pack-format)
+                                       "-pack"))
+           (target      (assoc-ref opts 'target))
+           (bootstrap?  (assoc-ref opts 'bootstrap?))
+           (compressor  (if bootstrap?
+                            (lookup-compressor "bootstrap-xz")
+                            (assoc-ref opts 'compressor)))
+           (tar         (if bootstrap?
+                            %bootstrap-tar
+                            tar))
+           (symlinks    (assoc-ref opts 'symlinks))
+           (build-image (match (assq-ref %formats pack-format)
+                          ((? procedure? proc) proc)
+                          (#f
+                           (leave (G_ "~a: unknown pack format")
+                                  format))))
+           (localstatedir? (assoc-ref opts 'localstatedir?)))
+      (with-store store
+        (parameterize ((%graft? (assoc-ref opts 'graft?))
+                       (%guile-for-build (package-derivation
+                                          store
+                                          (if (assoc-ref opts 'bootstrap?)
+                                              %bootstrap-guile
+                                              (canonical-package guile-2.2)))))
           ;; Set the build options before we do anything else.
           (set-build-options-from-command-line store opts)
 
           (run-with-store store
             (mlet* %store-monad ((profile (profile-derivation
                                            manifest
+                                           #:hooks (if bootstrap?
+                                                       '()
+                                                       %default-profile-hooks)
+                                           #:locales? (not bootstrap?)
                                            #:target target))
                                  (drv (build-image name profile
                                                    #:target
@@ -424,7 +449,9 @@ Create a bundle of PACKAGE.\n"))
                                                    #:symlinks
                                                    symlinks
                                                    #:localstatedir?
-                                                   localstatedir?)))
+                                                   localstatedir?
+                                                   #:tar
+                                                   tar)))
               (mbegin %store-monad
                 (show-what-to-build* (list drv)
                                      #:use-substitutes?
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
new file mode 100644
index 000000000..cb141e628
--- /dev/null
+++ b/tests/guix-pack.sh
@@ -0,0 +1,74 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the `guix pack' command-line utility.
+#
+
+guix pack --version
+
+# Use --no-substitutes because we need to verify we can do this ourselves.
+GUIX_BUILD_OPTIONS="--no-substitutes"
+export GUIX_BUILD_OPTIONS
+
+# Build a tarball with no compression.
+guix pack --compression=none --bootstrap guile-bootstrap
+
+# Build a tarball (with compression).
+guix pack --bootstrap guile-bootstrap
+
+# Build a tarball with a symlink.
+the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
+
+is_available () {
+    # Use the "type" shell builtin to see if the program is on PATH.
+    type "$1"
+}
+
+if is_available chroot && is_available unshare; then
+    # Verify we can extract and use it.
+    test_directory="`mktemp -d`"
+    trap 'rm -rf "$test_directory"' EXIT
+    cd "$test_directory"
+    tar -xf "$the_pack"
+    unshare -r chroot . /opt/gnu/bin/guile --version
+    cd -
+else
+    echo "skipping pack verification because chroot or unshare is unavailable"
+fi
+
+# For the tests that build Docker images below, we currently have to use
+# --dry-run because if we don't, there are only two possible cases:
+#
+#     Case 1: We do not use --bootstrap, and the build takes hours to finish
+#             because it needs to build tar etc.
+#
+#     Case 2: We use --bootstrap, and the build fails because the bootstrap
+#             Guile cannot dlopen shared libraries.  Not to mention the fact
+#             that we would still have to build many non-bootstrap inputs
+#             (e.g., guile-json) in order to create the Docker image.
+
+# Build a Docker image.
+guix pack --dry-run --bootstrap -f docker guile-bootstrap
+
+# Build a Docker image with a symlink.
+guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
+
+# Build a tarball pack of cross-compiled software.  Use coreutils because
+# guile-bootstrap is not intended to be cross-compiled.
+guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
-- 
2.15.1

[bug#30572] [PATCH 3/7] vm: Allow control of deduplication in root-partition-initializer.

[Chris Marusich]

* gnu/build/vm.scm (root-partition-initializer): Add #:deduplicate?
  keyword argument.
---
 gnu/build/vm.scm | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..6380df0a1 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -318,11 +319,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
@@ -347,7 +351,8 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
       (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)))
-- 
2.15.1

[bug#30572] [PATCH 4/7] gnu: When building in a VM, share a temporary directory.

[Chris Marusich]

* gnu/build/vm.scm (load-in-linux-vm): Make a shared temporary directory
  available in the VM.
* gnu/system/vm.scm (%linux-vm-file-systems): Add a corresponding entry.
---
 gnu/build/vm.scm  |  7 +++++++
 gnu/system/vm.scm | 12 ++++++++++--
 2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 6380df0a1..806744a64 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -128,6 +128,7 @@ the #:references-graphs parameter of 'derivation'."
       (error "qemu-img failed")))
 
   (mkdir "xchg")
+  (mkdir "tmp")
 
   (match references-graphs
     ((graph-files ...)
@@ -149,6 +150,12 @@ the #:references-graphs parameter of 'derivation'."
                   "-virtfs"
                   (string-append "local,id=xchg_dev,path=xchg"
                                  ",security_model=none,mount_tag=xchg")
+                  "-virtfs"
+                  ;; Some programs require more space in /tmp than is normally
+                  ;; available in the guest.  Accommodate such programs by
+                  ;; sharing a temporary directory.
+                  (string-append "local,id=tmp_dev,path=tmp"
+                                 ",security_model=none,mount_tag=tmp")
                   "-kernel" linux
                   "-initrd" initrd
                   "-append" (string-append "console=ttyS0 --load="
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index ae8780d2e..d239fa56a 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -87,8 +88,8 @@
 ;;; Code:
 
 (define %linux-vm-file-systems
-  ;; File systems mounted for 'derivation-in-linux-vm'.  The store and /xchg
-  ;; directory are shared with the host over 9p.
+  ;; File systems mounted for 'derivation-in-linux-vm'.  These are shared with
+  ;; the host over 9p.
   (list (file-system
           (mount-point (%store-prefix))
           (device "store")
@@ -102,6 +103,13 @@
           (type "9p")
           (needed-for-boot? #t)
           (options "trans=virtio")
+          (check? #f))
+        (file-system
+          (mount-point "/tmp")
+          (device "tmp")
+          (type "9p")
+          (needed-for-boot? #t)
+          (options "trans=virtio")
           (check? #f))))
 
 (define* (expression->derivation-in-linux-vm name exp
-- 
2.15.1

[bug#30572] [PATCH 5/7] guix: Rewrite build-docker-image to allow more paths.

[Chris Marusich]

* guix/docker.scm (build-docker-image): Rename "path" argument to
  "prefix" to reflect the fact that it is used as a prefix for the
  symlink targets.  Add the "paths" argument, and remove the "closure"
  argument, since it is now redundant.  Add a "transformations"
  argument.
* guix/scripts/pack.scm (docker-image): Read the profile's reference
  graph and provide its paths to build-docker-image via the new "paths"
  argument.
---
 guix/docker.scm       | 200 ++++++++++++++++++++++++++++++--------------------
 guix/scripts/pack.scm |   9 ++-
 2 files changed, 128 insertions(+), 81 deletions(-)

diff --git a/guix/docker.scm b/guix/docker.scm
index 060232148..a75534c33 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,9 +24,12 @@
   #:use-module ((guix build utils)
                 #:select (mkdir-p
                           delete-file-recursively
-                          with-directory-excursion))
-  #:use-module (guix build store-copy)
+                          with-directory-excursion
+                          invoke))
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module ((texinfo string-utils)
+                #:select (escape-special-chars))
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:export (build-docker-image))
@@ -33,8 +37,7 @@
 ;; Load Guile-JSON at run time to simplify the job of 'imported-modules' & co.
 (module-use! (current-module) (resolve-interface '(json)))
 
-;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image
-;; containing the closure at PATH.
+;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image.
 (define docker-id
   (compose bytevector->base16-string sha256 string->utf8))
 
@@ -102,82 +105,123 @@ return \"a\"."
     ((first rest ...)
      first)))
 
-(define* (build-docker-image image path
-                             #:key closure compressor
+(define* (build-docker-image image paths prefix
+                             #:key
                              (symlinks '())
+                             (transformations '())
                              (system (utsname:machine (uname)))
+                             compressor
                              (creation-time (current-time time-utc)))
-  "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
-describing symlinks to be created in the image, where each TARGET is relative
-to PATH.  SYSTEM is a GNU triplet (or prefix thereof) of the system the
-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
-        (closure (canonicalize-path closure))
-        (id (docker-id path))
-        (time (date->string (time-utc->date creation-time) "~4"))
-        (arch (let-syntax ((cond* (syntax-rules ()
-                                    ((_ (pattern clause) ...)
-                                     (cond ((string-prefix? pattern system)
-                                            clause)
-                                           ...
-                                           (else
-                                            (error "unsupported system"
-                                                   system)))))))
-                (cond* ("x86_64" "amd64")
-                       ("i686"   "386")
-                       ("arm"    "arm")
-                       ("mips64" "mips64le")))))
+  "Write to IMAGE a Docker image archive containing the given PATHS.  PREFIX
+must be a store path that is a prefix of any store paths in PATHS.
+
+SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be
+created in the image, where each TARGET is relative to PREFIX.
+TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to
+transform the PATHS.  Any path in PATHS that begins with OLD will be rewritten
+in the Docker image so that it begins with NEW instead.  If a path is a
+non-empty directory, then its contents will be recursively added, as well.
+
+SYSTEM is a GNU triplet (or prefix thereof) of the system the binaries in
+PATHS 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."
+  (define (sanitize path-fragment)
+    (escape-special-chars
+     ;; GNU tar strips the leading slash off of absolute paths before applying
+     ;; the transformations, so we need to do the same, or else our
+     ;; replacements won't match any paths.
+     (string-trim path-fragment #\/)
+     ;; Escape the basic regexp special characters (see: "(sed) BRE syntax").
+     ;; We also need to escape "/" because we use it as a delimiter.
+     "/*.^$[]\\"
+     #\\))
+  (define transformation->replacement
+    (match-lambda
+      ((old '-> new)
+       ;; See "(tar) transform" for details on the expression syntax.
+       (string-append "s/^" (sanitize old) "/" (sanitize new) "/"))))
+  (define (transformations->expression transformations)
+    (let ((replacements (map transformation->replacement transformations)))
+      (string-append
+       ;; Avoid transforming link targets, since that would break some links
+       ;; (e.g., symlinks that point to an absolute store path).
+       "flags=rSH;"
+       (string-join replacements ";")
+       ;; Some paths might still have a leading path delimiter even after tar
+       ;; transforms them (e.g., "/a/b" might be transformed into "/b"), so
+       ;; strip any leading path delimiters that remain.
+       ";s,^//*,,")))
+  (define transformation-options
+    (if (eq? '() transformations)
+        '()
+        `("--transform" ,(transformations->expression transformations))))
+  (let* ((directory "/tmp/docker-image") ;temporary working directory
+         (id (docker-id prefix))
+         (time (date->string (time-utc->date creation-time) "~4"))
+         (arch (let-syntax ((cond* (syntax-rules ()
+                                     ((_ (pattern clause) ...)
+                                      (cond ((string-prefix? pattern system)
+                                             clause)
+                                            ...
+                                            (else
+                                             (error "unsupported system"
+                                                    system)))))))
+                 (cond* ("x86_64" "amd64")
+                        ("i686"   "386")
+                        ("arm"    "arm")
+                        ("mips64" "mips64le")))))
     ;; Make sure we start with a fresh, empty working directory.
     (mkdir directory)
-
-    (and (with-directory-excursion directory
-           (mkdir id)
-           (with-directory-excursion id
-             (with-output-to-file "VERSION"
-               (lambda () (display schema-version)))
-             (with-output-to-file "json"
-               (lambda () (scm->json (image-description id time))))
-
-             ;; Wrap it up.
-             (let ((items (call-with-input-file closure
-                            read-reference-graph)))
-               ;; Create SYMLINKS.
-               (for-each (match-lambda
-                           ((source '-> target)
-                            (let ((source (string-trim source #\/)))
-                              (mkdir-p (dirname source))
-                              (symlink (string-append path "/" target)
-                                       source))))
-                         symlinks)
-
-               (and (zero? (apply system* "tar" "-cf" "layer.tar"
-                                  (append %tar-determinism-options
-                                          items
-                                          (map symlink-source symlinks))))
-                    (for-each delete-file-recursively
-                              (map (compose topmost-component symlink-source)
-                                   symlinks)))))
-
-           (with-output-to-file "config.json"
-             (lambda ()
-               (scm->json (config (string-append id "/layer.tar")
-                                  time arch))))
-           (with-output-to-file "manifest.json"
-             (lambda ()
-               (scm->json (manifest path id))))
-           (with-output-to-file "repositories"
-             (lambda ()
-               (scm->json (repositories path id)))))
-
-         (and (zero? (apply system* "tar" "-C" directory "-cf" image
-                            `(,@%tar-determinism-options
-                              ,@(if compressor
-                                    (list "-I" (string-join compressor))
-                                    '())
-                              ".")))
-              (begin (delete-file-recursively directory) #t)))))
+    (with-directory-excursion directory
+      (mkdir id)
+      (with-directory-excursion id
+        (with-output-to-file "VERSION"
+          (lambda () (display schema-version)))
+        (with-output-to-file "json"
+          (lambda () (scm->json (image-description id time))))
+
+        ;; Create SYMLINKS.
+        (for-each (match-lambda
+                    ((source '-> target)
+                     (let ((source (string-trim source #\/)))
+                       (mkdir-p (dirname source))
+                       (symlink (string-append prefix "/" target)
+                                source))))
+                  symlinks)
+
+        (apply invoke "tar" "-cf" "layer.tar"
+               `(,@transformation-options
+                 ,@%tar-determinism-options
+                 ,@paths
+                 ,@(map symlink-source symlinks)))
+        ;; It is possible for "/" to show up in the archive, especially when
+        ;; applying transformations.  For example, the transformation
+        ;; "s,^/a,," will (perhaps surprisingly) cause GNU tar to transform
+        ;; the path "/a" into "/".  The presence of "/" in the archive is
+        ;; probably benign, but it is definitely safe to remove it, so let's
+        ;; do that.  This fails when "/" is not in the archive, so use system*
+        ;; instead of invoke to avoid an exception in that case.
+        (system* "tar" "--delete" "/" "-f" "layer.tar")
+        (for-each delete-file-recursively
+                  (map (compose topmost-component symlink-source)
+                       symlinks)))
+
+      (with-output-to-file "config.json"
+        (lambda ()
+          (scm->json (config (string-append id "/layer.tar")
+                             time arch))))
+      (with-output-to-file "manifest.json"
+        (lambda ()
+          (scm->json (manifest prefix id))))
+      (with-output-to-file "repositories"
+        (lambda ()
+          (scm->json (repositories prefix id)))))
+
+    (apply invoke "tar" "-cf" image "-C" directory
+           `(,@%tar-determinism-options
+             ,@(if compressor
+                   (list "-I" (string-join compressor))
+                   '())
+             "."))
+    (delete-file-recursively directory)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 64ed44460..fba17f8e5 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -235,6 +235,7 @@ the image."
   (define build
     (with-imported-modules `(,@(source-module-closure '((guix docker))
                                                       #:select? not-config?)
+                             (guix build store-copy)
                              ((guix config) => ,config))
       #~(begin
           ;; Guile-JSON is required by (guix docker).
@@ -242,13 +243,15 @@ the image."
            (string-append #+json "/share/guile/site/"
                           (effective-version)))
 
-          (use-modules (guix docker) (srfi srfi-19))
+          (use-modules (guix docker) (srfi srfi-19) (guix build store-copy))
 
           (setenv "PATH" (string-append #$tar "/bin"))
 
-          (build-docker-image #$output #$profile
+          (build-docker-image #$output
+                              (call-with-input-file "profile"
+                                read-reference-graph)
+                              #$profile
                               #:system (or #$target (utsname:machine (uname)))
-                              #:closure "profile"
                               #:symlinks '#$symlinks
                               #:compressor '#$(compressor-command compressor)
                               #:creation-time (make-time time-utc 0 1)))))
-- 
2.15.1

[bug#30572] [PATCH 6/7] system: Add "guix system docker-image" command.

[Chris Marusich]

* gnu/system/vm.scm (system-docker-image): New procedure.
* guix/scripts/system.scm (system-derivation-for-action): Add a case for
  docker-image, and in that case, call system-docker-image.
  (show-help): Document docker-image.
  (guix-system): Parse arguments for docker-image.
* doc/guix.texi (Invoking guix system): Document "guix system
  docker-image".
* gnu/system/examples/docker-image.tmpl: New file.
---
 doc/guix.texi                         |  36 +++++++++--
 gnu/system/examples/docker-image.tmpl |  47 ++++++++++++++
 gnu/system/vm.scm                     | 113 ++++++++++++++++++++++++++++++++++
 guix/scripts/system.scm               |  12 ++--
 4 files changed, 200 insertions(+), 8 deletions(-)
 create mode 100644 gnu/system/examples/docker-image.tmpl

diff --git a/doc/guix.texi b/doc/guix.texi
index 792539a12..8d38c3d4a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20361,12 +20361,18 @@ containing at least the kernel, initrd, and bootloader data files must
 be created.  The @code{--image-size} option can be used to specify the
 size of the image.
 
+@cindex System images, creation in various formats
+@cindex Creating system images in various formats
 @item vm-image
 @itemx disk-image
-Return a virtual machine or disk image of the operating system declared
-in @var{file} that stands alone.  By default, @command{guix system}
-estimates the size of the image needed to store the system, but you can
-use the @option{--image-size} option to specify a value.
+@itemx docker-image
+Return a virtual machine, disk image, or Docker image of the operating
+system declared in @var{file} that stands alone.  By default,
+@command{guix system} estimates the size of the image needed to store
+the system, but you can use the @option{--image-size} option to specify
+a value.  Docker images are built to contain exactly what they need, so
+the @option{--image-size} option is ignored in the case of
+@code{docker-image}.
 
 You can specify the root file system type by using the
 @option{--file-system-type} option.  It defaults to @code{ext4}.
@@ -20384,6 +20390,28 @@ using the following command:
 # dd if=$(guix system disk-image my-os.scm) of=/dev/sdc
 @end example
 
+When using @code{docker-image}, a Docker image is produced.  Guix builds
+the image from scratch, not from a pre-existing Docker base image.  As a
+result, it contains @emph{exactly} what you define in the operating
+system configuration file.  You can then load the image and launch a
+Docker container using commands like the following:
+
+@example
+image_id="$(docker load < guixsd-docker-image.tar.gz)"
+docker run -e GUIX_NEW_SYSTEM=/var/guix/profiles/system \\
+    --entrypoint /var/guix/profiles/system/profile/bin/guile \\
+    $image_id /var/guix/profiles/system/boot
+@end example
+
+This command starts a new Docker container from the specified image.  It
+will boot the GuixSD system in the usual manner, which means it will
+start any services you have defined in the operating system
+configuration.  Depending on what you run in the Docker container, it
+may be necessary to give the container additional permissions.  For
+example, if you intend to build software using Guix inside of the Docker
+container, you may need to pass the @option{--privileged} option to
+@code{docker run}.
+
 @item container
 Return a script to run the operating system declared in @var{file}
 within a container.  Containers are a set of lightweight isolation
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
new file mode 100644
index 000000000..d73187398
--- /dev/null
+++ b/gnu/system/examples/docker-image.tmpl
@@ -0,0 +1,47 @@
+;; This is an operating system configuration template for a "Docker image"
+;; setup, so it has barely any services at all.
+
+(use-modules (gnu))
+
+(operating-system
+  (host-name "komputilo")
+  (timezone "Europe/Berlin")
+  (locale "en_US.utf8")
+
+  ;; This is where user accounts are specified.  The "root" account is
+  ;; implicit, and is initially created with the empty password.
+  (users (cons (user-account
+                (name "alice")
+                (comment "Bob's sister")
+                (group "users")
+                (supplementary-groups '("wheel"
+                                        "audio" "video"))
+                (home-directory "/home/alice"))
+               %base-user-accounts))
+
+  ;; Globally-installed packages.
+  (packages %base-packages)
+
+  ;; Because the system will run in a Docker container, we may omit many
+  ;; things that would normally be required in an operating system
+  ;; configuration file.  These things include:
+  ;;
+  ;;   * bootloader
+  ;;   * file-systems
+  ;;   * services such as mingetty, udevd, slim, networking, dhcp
+  ;;
+  ;; Either these things are simply not required, or Docker provides
+  ;; similar services for us.
+
+  ;; This will be ignored.
+  (bootloader (bootloader-configuration
+               (bootloader grub-bootloader)
+               (target "does-not-matter")))
+  ;; This will be ignored, too.
+  (file-systems (list (file-system
+                        (device "does-not-matter")
+                        (mount-point "/")
+                        (type "does-not-matter"))))
+
+  ;; Guix is all you need!
+  (services (list (guix-service))))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index d239fa56a..dd3641151 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -23,6 +23,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)
@@ -30,6 +31,7 @@
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix modules)
+  #:use-module (guix scripts pack)
   #:use-module (guix utils)
   #:use-module (guix hash)
   #:use-module (guix base32)
@@ -39,7 +41,9 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages cdrom)
+  #:use-module (gnu packages compression)
   #: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)
@@ -76,6 +80,7 @@
             system-qemu-image/shared-store
             system-qemu-image/shared-store-script
             system-disk-image
+            system-docker-image
 
             virtual-machine
             virtual-machine?))
@@ -376,6 +381,114 @@ the image."
    #:disk-image-format disk-image-format
    #:references-graphs inputs))
 
+(define* (system-docker-image os
+                              #:key
+                              (name "guixsd-docker-image")
+                              register-closures?)
+  "Build a docker image.  OS is the desired <operating-system>.  NAME is the
+base name to use for the output file.  When REGISTER-CLOSURES? is not #f,
+register the closure of OS with Guix in the resulting Docker image.  This only
+makes sense when you want to build a GuixSD Docker image that has Guix
+installed inside of it.  If you don't need Guix (e.g., your GuixSD Docker
+image just contains a web server that is started by the Shepherd), then you
+should set REGISTER-CLOSURES? to #f."
+  (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))
+
+  (mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t))
+                      (name -> (string-append name ".tar.gz"))
+                      (graph -> "system-graph"))
+    (define build
+      (with-imported-modules `(,@(source-module-closure '((guix docker)
+                                                          (guix build utils)
+                                                          (gnu build vm))
+                                                        #:select? not-config?)
+                               (guix build store-copy)
+                               ((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 (guix docker)
+                         (guix build utils)
+                         (gnu build vm)
+                         (srfi srfi-19)
+                         (guix build store-copy))
+
+            (let* ((inputs '#$(append (list tar)
+                                      (if register-closures?
+                                          (list guix)
+                                          '())))
+                   ;; This initializer requires elevated privileges that are
+                   ;; not normally available in the build environment (e.g.,
+                   ;; it needs to create device nodes).  In order to obtain
+                   ;; such privileges, we run it as root in a VM.
+                   (initialize (root-partition-initializer
+                                #:closures '(#$graph)
+                                #:register-closures? #$register-closures?
+                                #:system-directory #$os-drv
+                                ;; De-duplication would fail due to
+                                ;; cross-device link errors, so don't do it.
+                                #:deduplicate? #f))
+                   ;; Even as root in a VM, the initializer would fail due to
+                   ;; lack of privileges if we use a root-directory that is on
+                   ;; a file system that is shared with the host (e.g., /tmp).
+                   (root-directory "/guixsd-system-root"))
+              (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+              (mkdir root-directory)
+              (initialize root-directory)
+              (build-docker-image
+               (string-append "/xchg/" #$name) ;; The output file.
+               (cons* root-directory
+                      (call-with-input-file (string-append "/xchg/" #$graph)
+                        read-reference-graph))
+               #$os-drv
+               #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
+               #:creation-time (make-time time-utc 0 1)
+               #:transformations `((,root-directory -> "")))))))
+    (expression->derivation-in-linux-vm
+     name
+     ;; The VM's initrd Guile doesn't support dlopen, but our "build" gexp
+     ;; needs to be run by a Guile that can dlopen libgcrypt.  The following
+     ;; hack works around that problem by putting the "build" gexp into an
+     ;; executable script (created by program-file) which, when executed, will
+     ;; run using a Guile that supports dlopen.  That way, the VM's initrd
+     ;; Guile can just execute it via invoke, without using dlopen.  See:
+     ;; https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html
+     (with-imported-modules `((guix build utils))
+       #~(begin
+           (use-modules (guix build utils))
+           ;; If we use execl instead of invoke here, the VM will crash with a
+           ;; kernel panic.
+           (invoke #$(program-file "build-docker-image" build))))
+     #:make-disk-image? #f
+     #:single-file-output? #t
+     #:references-graphs `((,graph ,os-drv)))))
+
 \f
 ;;;
 ;;; VM and disk images.
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index acfccce96..09f99b300 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -701,7 +701,9 @@ checking this by themselves in their 'check' procedure."
                                  ("iso9660" "image.iso")
                                  (_         "disk-image"))
                         #:disk-image-size image-size
-                        #:file-system-type file-system-type))))
+                        #:file-system-type file-system-type))
+    ((docker-image)
+     (system-docker-image os #:register-closures? #t))))
 
 (define (maybe-suggest-running-guix-pull)
   "Suggest running 'guix pull' if this has never been done before."
@@ -899,6 +901,8 @@ Some ACTIONS support additional ARGS.\n"))
    vm-image         build a freestanding virtual machine image\n"))
   (display (G_ "\
    disk-image       build a disk image, suitable for a USB stick\n"))
+  (display (G_ "\
+   docker-image     build a Docker image\n"))
   (display (G_ "\
    init             initialize a root file system to run GNU\n"))
   (display (G_ "\
@@ -1130,7 +1134,7 @@ argument list and OPTS is the option alist."
           (case action
             ((build container vm vm-image disk-image reconfigure init
               extension-graph shepherd-graph list-generations roll-back
-              switch-generation search)
+              switch-generation search docker-image)
              (alist-cons 'action action result))
             (else (leave (G_ "~a: unknown action~%") action))))))
 
@@ -1159,7 +1163,7 @@ argument list and OPTS is the option alist."
         (exit 1))
 
       (case action
-        ((build container vm vm-image disk-image reconfigure)
+        ((build container vm vm-image disk-image docker-image reconfigure)
          (unless (or (= count 1)
                      (and expr (= count 0)))
            (fail)))
-- 
2.15.1

[bug#30572] [PATCH 7/7] tests: Add tests for "guix system disk-image" et al.

[Chris Marusich]

* tests/guix-system.sh: Add test cases that exercise (1) all of the
  example files in gnu/system/examples, and (2) all of the "image"
  creation commands: vm, vm-image, disk-image, and docker-image.
---
 tests/guix-system.sh | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index ed8563c8a..211c26f43 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -1,6 +1,7 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 #
 # This file is part of GNU Guix.
 #
@@ -267,3 +268,19 @@ guix system build "$tmpdir/config.scm" -n
 # Searching.
 guix system search tor | grep "^name: tor"
 guix system search anonym network | grep "^name: tor"
+
+# Below, use -n (--dry-run) for the tests because if we actually tried to
+# build these images, the commands would take hours to run in the worst case.
+
+# Verify that the examples can be built.
+for example in gnu/system/examples/*; do
+    guix system -n disk-image $example
+done
+
+# Verify that the disk image types can be built.
+guix system -n vm gnu/system/examples/vm-image.tmpl
+guix system -n vm-image gnu/system/examples/vm-image.tmpl
+# This invocation was taken care of in the loop above:
+# guix system -n disk-image gnu/system/examples/bare-bones.tmpl
+guix system -n disk-image --file-system-type=iso9660 gnu/system/examples/bare-bones.tmpl
+guix system -n docker-image gnu/system/examples/docker-image.tmpl
-- 
2.15.1

[bug#30572] [PATCH 3/7] vm: Allow control of deduplication in root-partition-initializer.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 7 bytes --]

LGTM!

[-- Attachment #2: Digitale Signatur von OpenPGP --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 385 bytes --]

> +is_available () {
> +    # Use the "type" shell builtin to see if the program is on PATH.
> +    type "$1"

Maybe >/dev/null ?  Then it would only complain if it needed to.

> +else
> +    echo "skipping pack verification because chroot or unshare is unavailable"

echo "warning: Skipping pack verification because chroot or unshare is unavailable" >&2

Otherwise LGTM!

[-- Attachment #2: Digitale Signatur von OpenPGP --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 4/7] gnu: When building in a VM, share a temporary directory.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1428 bytes --]

LGTM!

There are now three manual "-virtfs" arguments to qemu.  It's starting to irk me
a little.  It might make sense to generate those from %linux-vm-filesystems
in order to not have so much duplication and places where things can go wrong
when maintaining.

If you'd like, could you maybe pass the %linux-vm-filesystems to
load-in-linux-vm and then automatically calculate those -virtfs entries?

(In a future patchset - I don't wanna hold up this one)

There's already common-qemu-options which would support <file-system-mapping>,
and %store-mapping, so actually it would make sense to use those (probably easiest
to move build/vm.scm's load-in-linux-vm into system/vm.scm
expression->derivation-in-linux-vm so the qemu stuff isn't scattered all over
the place - right now, half is in gnu/system/vm.scm and a mostly redundant half
is in gnu/build/vm.scm ... not ideal).

There's a "mapping->file-system" helper, so it might make sense to use
<file-system-mapping> instead of <file-system> in %linux-vm-filesystems.

So all in all:

* Modify %linux-vm-filesystems to be file-system-mappings instead of file-systems.
Also modify the place it is used.
* Move load-in-linux-vm to gnu/system/vm.scm (maybe inline into caller).
* Modify load-in-linux-vm to use common-qemu-options.
Notice that the "-append" option is passed twice.  Bug... <-- I just fixed that in master

If you want I can do it.

[-- Attachment #2: Digitale Signatur von OpenPGP --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 7/7] tests: Add tests for "guix system disk-image" et al.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 7 bytes --]

LGTM!

[-- Attachment #2: Digitale Signatur von OpenPGP --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 6/7] system: Add "guix system docker-image" command.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 7 bytes --]

LGTM!

[-- Attachment #2: Digitale Signatur von OpenPGP --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 265 bytes --]

> +(define (bootstrap-binary program-name)
...
> +    (license gpl3+)

I can't believe I'm nitpicking on this - but can we fish that out of the package

  (search-bootstrap-binary program-name (%current-system))

using package-license ?

Otherwise LGTM!

[-- Attachment #2: Digitale Signatur von OpenPGP --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 5/7] guix: Rewrite build-docker-image to allow more paths.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 763 bytes --]

> +  (define (sanitize path-fragment)
> +    (escape-special-chars
> +     ;; GNU tar strips the leading slash off of absolute paths before applying
> +     ;; the transformations, so we need to do the same, or else our
> +     ;; replacements won't match any paths.
> +     (string-trim path-fragment #\/)
> +     ;; Escape the basic regexp special characters (see: "(sed) BRE syntax").
> +     ;; We also need to escape "/" because we use it as a delimiter.
> +     "/*.^$[]\\"
> +     #\\))

I'm not such a fan of using blacklist.  Those can easily get out of sync and
nobody notices.  But in this case I guess people take care not to extend
basic regexp special characters in sed (tar) without the user specifying a flag
requiring it.

LGTM!

[-- Attachment #2: Digitale Signatur von OpenPGP --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 3/7] vm: Allow control of deduplication in root-partition-initializer.

[Ludovic Courtès]

Chris Marusich <cmmarusich@gmail.com> skribis:

> * gnu/build/vm.scm (root-partition-initializer): Add #:deduplicate?
>   keyword argument.

LGTM!

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> +is_available () {
>> +    # Use the "type" shell builtin to see if the program is on PATH.
>> +    type "$1"
>
> Maybe >/dev/null ?  Then it would only complain if it needed to.
>
>> +else
>> +    echo "skipping pack verification because chroot or unshare is unavailable"
>
> echo "warning: Skipping pack verification because chroot or unshare is unavailable" >&2
>
> Otherwise LGTM!

+1!

Ludo'.

[bug#30572] [PATCH 6/7] system: Add "guix system docker-image" command.

[Ludovic Courtès]

Hello Chris,

Chris Marusich <cmmarusich@gmail.com> skribis:

> * gnu/system/vm.scm (system-docker-image): New procedure.
> * guix/scripts/system.scm (system-derivation-for-action): Add a case for
>   docker-image, and in that case, call system-docker-image.
>   (show-help): Document docker-image.
>   (guix-system): Parse arguments for docker-image.
> * doc/guix.texi (Invoking guix system): Document "guix system
>   docker-image".
> * gnu/system/examples/docker-image.tmpl: New file.

Neat!

> +When using @code{docker-image}, a Docker image is produced.  Guix builds
> +the image from scratch, not from a pre-existing Docker base image.  As a
> +result, it contains @emph{exactly} what you define in the operating
> +system configuration file.  You can then load the image and launch a
> +Docker container using commands like the following:
> +
> +@example
> +image_id="$(docker load < guixsd-docker-image.tar.gz)"
> +docker run -e GUIX_NEW_SYSTEM=/var/guix/profiles/system \\
> +    --entrypoint /var/guix/profiles/system/profile/bin/guile \\
> +    $image_id /var/guix/profiles/system/boot
> +@end example
> +
> +This command starts a new Docker container from the specified image.  It
> +will boot the GuixSD system in the usual manner, which means it will
> +start any services you have defined in the operating system
> +configuration.  Depending on what you run in the Docker container, it
> +may be necessary to give the container additional permissions.  For
> +example, if you intend to build software using Guix inside of the Docker
> +container, you may need to pass the @option{--privileged} option to
> +@code{docker run}.

Awesome.

> +  (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))

I think we can use ‘guile-json’ unconditionally here.

> +              (mkdir root-directory)
> +              (initialize root-directory)
> +              (build-docker-image
> +               (string-append "/xchg/" #$name) ;; The output file.
> +               (cons* root-directory
> +                      (call-with-input-file (string-append "/xchg/" #$graph)
> +                        read-reference-graph))
> +               #$os-drv
> +               #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
> +               #:creation-time (make-time time-utc 0 1)
> +               #:transformations `((,root-directory -> "")))))))

Am I right that the whole point of passing several file names to
‘build-docker-image’ is that here we don’t need to copy the whole store
to ‘root-directory’, right?

I liked the simplicity of accepting a single file name in
‘build-docker-image’ (no need for #:transformations in that case), but I
reckon that copying everything around just to meet this requirement is
inefficient.

Otherwise LGTM, thanks!

Ludo’.

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Ludovic Courtès]

Chris Marusich <cmmarusich@gmail.com> skribis:

> * gnu/packages/bootstrap.scm (bootstrap-binary): New procedure.
>   (%bootstrap-bash, %bootstrap-mkdir, %bootstrap-tar, %bootstrap-xz):
>   Use it to create these new packages, and export them.

For ‘guix pack --bootstrap’, I believe we could avoid defining these
packages and simply use ‘%bootstrap-coreutils&co’ when ‘--bootstrap’ is
used.

Would that work for you?

I’m asking because we may not keep these 4 binaries around forever.

Thanks,
Ludo’.

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 2140 bytes --]

Danny Milosavljevic <dannym@scratchpost.org> writes:

>> +(define (bootstrap-binary program-name)
> ...
>> +    (license gpl3+)
>
> I can't believe I'm nitpicking on this - but can we fish that out of the package
>
>   (search-bootstrap-binary program-name (%current-system))
>
> using package-license ?

At first I tried to do what you suggest, but then it occurred to me that
this might create a loop in the module dependency graph.  For example,
if in the case of "bash" I use a form like (package-license bash) to
obtain the actual license used by the canonical bash package, the (gnu
packages bootstrap) module will now depend on the (gnu packages bash)
module.  I don't know how that will interact with the rest of Guix; it
seems safer to just avoid adding that and accept this small discrepancy
in the bootstrap packages.  It is simpler.

Note that the bootstrap binaries' licenses are not currently correctly
surfaced in every place to begin with.  For example, the license of the
"bootstrap-binaries" package (i.e., the %bootstrap-coreutils&co) is
defined to be gpl3+, even though it contains xz, which actually uses
gpl2+ and lgpl2.1+.  Since (I suspect) these packages are intended for
internal use, and since the canonical versions of these packages do have
correct sources, licenses, and so forth, I'm not so sure we need to be
very concerned about minor discrepancies like this.

ludo@gnu.org (Ludovic Courtès) writes:

> Chris Marusich <cmmarusich@gmail.com> skribis:
>
>> * gnu/packages/bootstrap.scm (bootstrap-binary): New procedure.
>>   (%bootstrap-bash, %bootstrap-mkdir, %bootstrap-tar, %bootstrap-xz):
>>   Use it to create these new packages, and export them.
>
> For ‘guix pack --bootstrap’, I believe we could avoid defining these
> packages and simply use ‘%bootstrap-coreutils&co’ when ‘--bootstrap’ is
> used.
>
> Would that work for you?

I considered this.  However, my understanding is that a network
connection is required to build %bootstrap-coreutils&co.  Would we want
to use it in tests even if it requires a network connection?

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 4/7] gnu: When building in a VM, share a temporary directory.

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 1873 bytes --]

Danny Milosavljevic <dannym@scratchpost.org> writes:

> There are now three manual "-virtfs" arguments to qemu.  It's starting to irk me
> a little.  It might make sense to generate those from %linux-vm-filesystems
> in order to not have so much duplication and places where things can go wrong
> when maintaining.
>
> If you'd like, could you maybe pass the %linux-vm-filesystems to
> load-in-linux-vm and then automatically calculate those -virtfs entries?
>
> (In a future patchset - I don't wanna hold up this one)

I agree this would be nice.  I also agree we should do it in a future
patch series.

> There's already common-qemu-options which would support
><file-system-mapping>,
> and %store-mapping, so actually it would make sense to use those (probably easiest
> to move build/vm.scm's load-in-linux-vm into system/vm.scm
> expression->derivation-in-linux-vm so the qemu stuff isn't scattered all over
> the place - right now, half is in gnu/system/vm.scm and a mostly redundant half
> is in gnu/build/vm.scm ... not ideal).
>
> There's a "mapping->file-system" helper, so it might make sense to use
> <file-system-mapping> instead of <file-system> in %linux-vm-filesystems.
>
> So all in all:
>
> * Modify %linux-vm-filesystems to be file-system-mappings instead of file-systems.
> Also modify the place it is used.
> * Move load-in-linux-vm to gnu/system/vm.scm (maybe inline into caller).
> * Modify load-in-linux-vm to use common-qemu-options.
> Notice that the "-append" option is passed twice.  Bug... <-- I just fixed that in master

Good catch!  Thank you for fixing it.

> If you want I can do it.

I wish I could say "I'll do it!", but honestly I might not be able to
get to it for a few weeks.  So if you have the time, by all means please
do it!  Otherwise, I might get around to it eventually.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 5/7] guix: Rewrite build-docker-image to allow more paths.

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 1264 bytes --]

Danny Milosavljevic <dannym@scratchpost.org> writes:

>> +  (define (sanitize path-fragment)
>> +    (escape-special-chars
>> +     ;; GNU tar strips the leading slash off of absolute paths before applying
>> +     ;; the transformations, so we need to do the same, or else our
>> +     ;; replacements won't match any paths.
>> +     (string-trim path-fragment #\/)
>> +     ;; Escape the basic regexp special characters (see: "(sed) BRE syntax").
>> +     ;; We also need to escape "/" because we use it as a delimiter.
>> +     "/*.^$[]\\"
>> +     #\\))
>
> I'm not such a fan of using blacklist.  Those can easily get out of sync and
> nobody notices.  But in this case I guess people take care not to extend
> basic regexp special characters in sed (tar) without the user specifying a flag
> requiring it.

That's a good point.  However, I think we're OK here, since we are in
full control over how we invoke tar.  To give us full control over how
we invoke tar, I specifically took care to hide the fact that we are
using tar under the covers to do the transformations.  Even if tar
silently changes its contract (that seems unlikely to me), we can just
change our code accordingly, and callers will be none the wiser.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1227 bytes --]

Hi Chris,

On Tue, 20 Mar 2018 04:13:41 +0100
Chris Marusich <cmmarusich@gmail.com> wrote:

> module.  I don't know how that will interact with the rest of Guix; it
> seems safer to just avoid adding that and accept this small discrepancy
> in the bootstrap packages.  It is simpler.

It would still be possible to do it using module-ref, but I'd advise
against it.  How about just passing an explicit license to the
bootstrap-binary procedure?

>For example, the license of the
>"bootstrap-binaries" package (i.e., the %bootstrap-coreutils&co)
> defined to be gpl3+, even though it contains xz, which actually uses
> gpl2+ and lgpl2.1+.

Yeah, I don't like that either.

>  Since (I suspect) these packages are intended for
> internal use, and since the canonical versions of these packages do have
> correct sources, licenses, and so forth, I'm not so sure we need to be
> very concerned about minor discrepancies like this.

Yeah, it's just a nitpick.  I'm fine with it being #f or with it being
a parameter to bootstrap-binary.  But (license license:gpl3+) when it's
not actually gpl3 is where I draw the line.  Wrong license like this is
never going to be flagged again except by adversaries.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 6/7] system: Add "guix system docker-image" command.

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 2998 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

>> +  (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))
>
> I think we can use ‘guile-json’ unconditionally here.

Good point.  Nobody using this new code will be using Guile 2.0, so we
can just use guile-json unconditionally.  Does that mean we can also
clean up the same conditional statement from other places in Guix code
now?

>> +              (mkdir root-directory)
>> +              (initialize root-directory)
>> +              (build-docker-image
>> +               (string-append "/xchg/" #$name) ;; The output file.
>> +               (cons* root-directory
>> +                      (call-with-input-file (string-append "/xchg/" #$graph)
>> +                        read-reference-graph))
>> +               #$os-drv
>> +               #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
>> +               #:creation-time (make-time time-utc 0 1)
>> +               #:transformations `((,root-directory -> "")))))))
>
> Am I right that the whole point of passing several file names to
> ‘build-docker-image’ is that here we don’t need to copy the whole store
> to ‘root-directory’, right?

The primary reason why I made this change was because it was the
simplest way I could find to re-use the existing code.  The fact that we
copy less is a nice secondary effect, but it is not the primary reason
why I structured it this way.  There might be a simpler way to
accomplish this, but this way works, which I think is a good start.  I
would like to commit this as-is for now.  If we can figure out a simpler
way to implement the same logic, I'd be all for it, but it seems tricky.

The original role of the "PATH" argument was surprising (for example, it
was not actually used for adding any paths to the final Docker image!).
In addition, the original code assumed that all the paths to add (loaded
from the "CLOSURE" graph file argument - not from PATH!) are store
paths, which is not true when creating a GuixSD Docker image (unless we
try to copy everything created by root-partition-initializer back into
the store).  So, some of the paths I need to add are store paths, and
some of them are paths to special files outside the store, like device
files.  Maybe we can copy all of this (including device files and socket
files) into a single directory in the store (or outside of the store).
I don't know.  If it's possible, I agree it would be a nice improvement.
But I tried various methods, and my latest patch was the simplest method
I found that worked.  I would definitely be happy if we could simplify
it even more, but I also want to move forward with this patch series.

Is it OK to commit this as-is (with just the guile-json change you
suggested above)?

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 617 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

> Danny Milosavljevic <dannym@scratchpost.org> skribis:
>
>>> +is_available () {
>>> +    # Use the "type" shell builtin to see if the program is on PATH.
>>> +    type "$1"
>>
>> Maybe >/dev/null ?  Then it would only complain if it needed to.
>>
>>> +else
>>> +    echo "skipping pack verification because chroot or unshare is unavailable"
>>
>> echo "warning: Skipping pack verification because chroot or unshare is unavailable" >&2
>>
>> Otherwise LGTM!
>
> +1!
>
> Ludo'.

Sure thing.  I'll include this change when pushing to origin.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Chris Marusich]

[-- Attachment #1.1: Type: text/plain, Size: 1492 bytes --]

Danny Milosavljevic <dannym@scratchpost.org> writes:

> Hi Chris,
>
> On Tue, 20 Mar 2018 04:13:41 +0100
> Chris Marusich <cmmarusich@gmail.com> wrote:
>
>> module.  I don't know how that will interact with the rest of Guix; it
>> seems safer to just avoid adding that and accept this small discrepancy
>> in the bootstrap packages.  It is simpler.
>
> It would still be possible to do it using module-ref, but I'd advise
> against it.  How about just passing an explicit license to the
> bootstrap-binary procedure?

Yes, that sounds like the right way to me.

>>For example, the license of the
>>"bootstrap-binaries" package (i.e., the %bootstrap-coreutils&co)
>> defined to be gpl3+, even though it contains xz, which actually uses
>> gpl2+ and lgpl2.1+.
>
> Yeah, I don't like that either.
>
>>  Since (I suspect) these packages are intended for
>> internal use, and since the canonical versions of these packages do have
>> correct sources, licenses, and so forth, I'm not so sure we need to be
>> very concerned about minor discrepancies like this.
>
> Yeah, it's just a nitpick.  I'm fine with it being #f or with it being
> a parameter to bootstrap-binary.  But (license license:gpl3+) when it's
> not actually gpl3 is where I draw the line.  Wrong license like this is
> never going to be flagged again except by adversaries.

I understand.  It isn't hard to fix, so here's a new patch that adds
correct licenses.  How does it look?

-- 
Chris

[-- Attachment #1.2: 0001-gnu-bootstrap-Add-trivial-packages-for-bash-mkdir-ta.patch --]
[-- Type: text/x-patch, Size: 3079 bytes --]

From 5398d4d98decd9e74dbf557203c6523107ce559b Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Sun, 11 Mar 2018 01:13:01 +0100
Subject: [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir,
 tar, and xz.

* gnu/packages/bootstrap.scm (bootstrap-binary): New procedure.
  (%bootstrap-bash, %bootstrap-mkdir, %bootstrap-tar, %bootstrap-xz):
  Use it to create these new packages, and export them.
---
 gnu/packages/bootstrap.scm | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index 27f2053c4..1480880ae 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,6 +44,10 @@
             bootstrap-guile-origin
 
             %bootstrap-guile
+            %bootstrap-bash
+            %bootstrap-mkdir
+            %bootstrap-tar
+            %bootstrap-xz
             %bootstrap-coreutils&co
             %bootstrap-binutils
             %bootstrap-gcc
@@ -345,6 +350,35 @@ $out/bin/guile --version~%"
      (home-page #f)
      (license lgpl3+))))
 
+(define (bootstrap-binary program-name license)
+  (package
+    (name (string-append program-name "-bootstrap"))
+    ;; The version may differ depending on the program.
+    (version "unknown")
+    (source #f)
+    (build-system trivial-build-system)
+    (arguments
+     `(#:guile ,%bootstrap-guile
+       #:builder (let ((out (assoc-ref %outputs "out"))
+                       (program (assoc-ref %build-inputs ,program-name)))
+                   (mkdir out)
+                   (mkdir (string-append out "/bin"))
+                   (symlink program (string-append out "/bin/" ,program-name)))))
+    (inputs `((,program-name ,(search-bootstrap-binary program-name (%current-system)))))
+    (description (string-append "The bootstrap " program-name "."))
+    (synopsis (string-append "The bootstrap " program-name "."))
+    (license license)
+    (home-page #f)))
+
+;; These trivial packages provide individual binaries that are also included
+;; in %bootstrap-coreutils&co.  However, these packages are more minimal than
+;; %bootstrap-coreutils&co, and they do not require network access to build
+;; because these specific binaries are included in the Guix source tree.
+(define %bootstrap-bash (bootstrap-binary "bash" gpl3+))
+(define %bootstrap-mkdir (bootstrap-binary "mkdir" gpl3+))
+(define %bootstrap-tar (bootstrap-binary "tar" gpl3+))
+(define %bootstrap-xz (bootstrap-binary "xz" (list gpl2+ lgpl2.1+)))
+
 (define %bootstrap-coreutils&co
   (package-from-tarball "bootstrap-binaries"
                         (lambda (system)
-- 
2.15.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 911 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

> Chris Marusich <cmmarusich@gmail.com> skribis:
>
>> * gnu/packages/bootstrap.scm (bootstrap-binary): New procedure.
>>   (%bootstrap-bash, %bootstrap-mkdir, %bootstrap-tar, %bootstrap-xz):
>>   Use it to create these new packages, and export them.
>
> For ‘guix pack --bootstrap’, I believe we could avoid defining these
> packages and simply use ‘%bootstrap-coreutils&co’ when ‘--bootstrap’ is
> used.
>
> Would that work for you?
>
> I’m asking because we may not keep these 4 binaries around forever.

%bootstrap-coreutils&co requires a network connection to build.  Is it
OK to use it in tests even though it requires a network connection?  If
it's OK, then I'll use it, but I thought we wanted to avoid relying on a
network connection in tests, which is why I defined new packages that do
not rely on the network.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 6/7] system: Add "guix system docker-image" command.

[Chris Marusich]

[-- Attachment #1.1: Type: text/plain, Size: 219 bytes --]

Chris Marusich <cmmarusich@gmail.com> writes:

> Is it OK to commit this as-is (with just the guile-json change you
> suggested above)?

Here's an updated patch which contains the guile-json change.

-- 
Chris

[-- Attachment #1.2: 0006-system-Add-guix-system-docker-image-command.patch --]
[-- Type: text/x-patch, Size: 14864 bytes --]

From 35f930186bcdc7863ac6ce19b0dba428b3cfab3a Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Mon, 19 Feb 2018 05:45:03 +0100
Subject: [PATCH 6/7] system: Add "guix system docker-image" command.

* gnu/system/vm.scm (system-docker-image): New procedure.
* guix/scripts/system.scm (system-derivation-for-action): Add a case for
  docker-image, and in that case, call system-docker-image.
  (show-help): Document docker-image.
  (guix-system): Parse arguments for docker-image.
* doc/guix.texi (Invoking guix system): Document "guix system
  docker-image".
* gnu/system/examples/docker-image.tmpl: New file.
---
 doc/guix.texi                         |  36 ++++++++++--
 gnu/system/examples/docker-image.tmpl |  47 +++++++++++++++
 gnu/system/vm.scm                     | 105 ++++++++++++++++++++++++++++++++++
 guix/scripts/system.scm               |  12 ++--
 4 files changed, 192 insertions(+), 8 deletions(-)
 create mode 100644 gnu/system/examples/docker-image.tmpl

diff --git a/doc/guix.texi b/doc/guix.texi
index 792539a12..8d38c3d4a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20361,12 +20361,18 @@ containing at least the kernel, initrd, and bootloader data files must
 be created.  The @code{--image-size} option can be used to specify the
 size of the image.
 
+@cindex System images, creation in various formats
+@cindex Creating system images in various formats
 @item vm-image
 @itemx disk-image
-Return a virtual machine or disk image of the operating system declared
-in @var{file} that stands alone.  By default, @command{guix system}
-estimates the size of the image needed to store the system, but you can
-use the @option{--image-size} option to specify a value.
+@itemx docker-image
+Return a virtual machine, disk image, or Docker image of the operating
+system declared in @var{file} that stands alone.  By default,
+@command{guix system} estimates the size of the image needed to store
+the system, but you can use the @option{--image-size} option to specify
+a value.  Docker images are built to contain exactly what they need, so
+the @option{--image-size} option is ignored in the case of
+@code{docker-image}.
 
 You can specify the root file system type by using the
 @option{--file-system-type} option.  It defaults to @code{ext4}.
@@ -20384,6 +20390,28 @@ using the following command:
 # dd if=$(guix system disk-image my-os.scm) of=/dev/sdc
 @end example
 
+When using @code{docker-image}, a Docker image is produced.  Guix builds
+the image from scratch, not from a pre-existing Docker base image.  As a
+result, it contains @emph{exactly} what you define in the operating
+system configuration file.  You can then load the image and launch a
+Docker container using commands like the following:
+
+@example
+image_id="$(docker load < guixsd-docker-image.tar.gz)"
+docker run -e GUIX_NEW_SYSTEM=/var/guix/profiles/system \\
+    --entrypoint /var/guix/profiles/system/profile/bin/guile \\
+    $image_id /var/guix/profiles/system/boot
+@end example
+
+This command starts a new Docker container from the specified image.  It
+will boot the GuixSD system in the usual manner, which means it will
+start any services you have defined in the operating system
+configuration.  Depending on what you run in the Docker container, it
+may be necessary to give the container additional permissions.  For
+example, if you intend to build software using Guix inside of the Docker
+container, you may need to pass the @option{--privileged} option to
+@code{docker run}.
+
 @item container
 Return a script to run the operating system declared in @var{file}
 within a container.  Containers are a set of lightweight isolation
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
new file mode 100644
index 000000000..d73187398
--- /dev/null
+++ b/gnu/system/examples/docker-image.tmpl
@@ -0,0 +1,47 @@
+;; This is an operating system configuration template for a "Docker image"
+;; setup, so it has barely any services at all.
+
+(use-modules (gnu))
+
+(operating-system
+  (host-name "komputilo")
+  (timezone "Europe/Berlin")
+  (locale "en_US.utf8")
+
+  ;; This is where user accounts are specified.  The "root" account is
+  ;; implicit, and is initially created with the empty password.
+  (users (cons (user-account
+                (name "alice")
+                (comment "Bob's sister")
+                (group "users")
+                (supplementary-groups '("wheel"
+                                        "audio" "video"))
+                (home-directory "/home/alice"))
+               %base-user-accounts))
+
+  ;; Globally-installed packages.
+  (packages %base-packages)
+
+  ;; Because the system will run in a Docker container, we may omit many
+  ;; things that would normally be required in an operating system
+  ;; configuration file.  These things include:
+  ;;
+  ;;   * bootloader
+  ;;   * file-systems
+  ;;   * services such as mingetty, udevd, slim, networking, dhcp
+  ;;
+  ;; Either these things are simply not required, or Docker provides
+  ;; similar services for us.
+
+  ;; This will be ignored.
+  (bootloader (bootloader-configuration
+               (bootloader grub-bootloader)
+               (target "does-not-matter")))
+  ;; This will be ignored, too.
+  (file-systems (list (file-system
+                        (device "does-not-matter")
+                        (mount-point "/")
+                        (type "does-not-matter"))))
+
+  ;; Guix is all you need!
+  (services (list (guix-service))))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index d239fa56a..af49065f3 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -23,6 +23,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)
@@ -30,6 +31,7 @@
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix modules)
+  #:use-module (guix scripts pack)
   #:use-module (guix utils)
   #:use-module (guix hash)
   #:use-module (guix base32)
@@ -39,7 +41,9 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages cdrom)
+  #:use-module (gnu packages compression)
   #: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)
@@ -76,6 +80,7 @@
             system-qemu-image/shared-store
             system-qemu-image/shared-store-script
             system-disk-image
+            system-docker-image
 
             virtual-machine
             virtual-machine?))
@@ -376,6 +381,106 @@ the image."
    #:disk-image-format disk-image-format
    #:references-graphs inputs))
 
+(define* (system-docker-image os
+                              #:key
+                              (name "guixsd-docker-image")
+                              register-closures?)
+  "Build a docker image.  OS is the desired <operating-system>.  NAME is the
+base name to use for the output file.  When REGISTER-CLOSURES? is not #f,
+register the closure of OS with Guix in the resulting Docker image.  This only
+makes sense when you want to build a GuixSD Docker image that has Guix
+installed inside of it.  If you don't need Guix (e.g., your GuixSD Docker
+image just contains a web server that is started by the Shepherd), then you
+should set REGISTER-CLOSURES? to #f."
+  (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"))))))
+  (mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t))
+                      (name -> (string-append name ".tar.gz"))
+                      (graph -> "system-graph"))
+    (define build
+      (with-imported-modules `(,@(source-module-closure '((guix docker)
+                                                          (guix build utils)
+                                                          (gnu build vm))
+                                                        #:select? not-config?)
+                               (guix build store-copy)
+                               ((guix config) => ,config))
+        #~(begin
+            ;; Guile-JSON is required by (guix docker).
+            (add-to-load-path
+             (string-append #+guile-json "/share/guile/site/"
+                            (effective-version)))
+            (use-modules (guix docker)
+                         (guix build utils)
+                         (gnu build vm)
+                         (srfi srfi-19)
+                         (guix build store-copy))
+
+            (let* ((inputs '#$(append (list tar)
+                                      (if register-closures?
+                                          (list guix)
+                                          '())))
+                   ;; This initializer requires elevated privileges that are
+                   ;; not normally available in the build environment (e.g.,
+                   ;; it needs to create device nodes).  In order to obtain
+                   ;; such privileges, we run it as root in a VM.
+                   (initialize (root-partition-initializer
+                                #:closures '(#$graph)
+                                #:register-closures? #$register-closures?
+                                #:system-directory #$os-drv
+                                ;; De-duplication would fail due to
+                                ;; cross-device link errors, so don't do it.
+                                #:deduplicate? #f))
+                   ;; Even as root in a VM, the initializer would fail due to
+                   ;; lack of privileges if we use a root-directory that is on
+                   ;; a file system that is shared with the host (e.g., /tmp).
+                   (root-directory "/guixsd-system-root"))
+              (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+              (mkdir root-directory)
+              (initialize root-directory)
+              (build-docker-image
+               (string-append "/xchg/" #$name) ;; The output file.
+               (cons* root-directory
+                      (call-with-input-file (string-append "/xchg/" #$graph)
+                        read-reference-graph))
+               #$os-drv
+               #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
+               #:creation-time (make-time time-utc 0 1)
+               #:transformations `((,root-directory -> "")))))))
+    (expression->derivation-in-linux-vm
+     name
+     ;; The VM's initrd Guile doesn't support dlopen, but our "build" gexp
+     ;; needs to be run by a Guile that can dlopen libgcrypt.  The following
+     ;; hack works around that problem by putting the "build" gexp into an
+     ;; executable script (created by program-file) which, when executed, will
+     ;; run using a Guile that supports dlopen.  That way, the VM's initrd
+     ;; Guile can just execute it via invoke, without using dlopen.  See:
+     ;; https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html
+     (with-imported-modules `((guix build utils))
+       #~(begin
+           (use-modules (guix build utils))
+           ;; If we use execl instead of invoke here, the VM will crash with a
+           ;; kernel panic.
+           (invoke #$(program-file "build-docker-image" build))))
+     #:make-disk-image? #f
+     #:single-file-output? #t
+     #:references-graphs `((,graph ,os-drv)))))
+
 \f
 ;;;
 ;;; VM and disk images.
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index acfccce96..09f99b300 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -701,7 +701,9 @@ checking this by themselves in their 'check' procedure."
                                  ("iso9660" "image.iso")
                                  (_         "disk-image"))
                         #:disk-image-size image-size
-                        #:file-system-type file-system-type))))
+                        #:file-system-type file-system-type))
+    ((docker-image)
+     (system-docker-image os #:register-closures? #t))))
 
 (define (maybe-suggest-running-guix-pull)
   "Suggest running 'guix pull' if this has never been done before."
@@ -899,6 +901,8 @@ Some ACTIONS support additional ARGS.\n"))
    vm-image         build a freestanding virtual machine image\n"))
   (display (G_ "\
    disk-image       build a disk image, suitable for a USB stick\n"))
+  (display (G_ "\
+   docker-image     build a Docker image\n"))
   (display (G_ "\
    init             initialize a root file system to run GNU\n"))
   (display (G_ "\
@@ -1130,7 +1134,7 @@ argument list and OPTS is the option alist."
           (case action
             ((build container vm vm-image disk-image reconfigure init
               extension-graph shepherd-graph list-generations roll-back
-              switch-generation search)
+              switch-generation search docker-image)
              (alist-cons 'action action result))
             (else (leave (G_ "~a: unknown action~%") action))))))
 
@@ -1159,7 +1163,7 @@ argument list and OPTS is the option alist."
         (exit 1))
 
       (case action
-        ((build container vm vm-image disk-image reconfigure)
+        ((build container vm vm-image disk-image docker-image reconfigure)
          (unless (or (= count 1)
                      (and expr (= count 0)))
            (fail)))
-- 
2.15.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Chris Marusich]

[-- Attachment #1.1: Type: text/plain, Size: 306 bytes --]

Chris Marusich <cmmarusich@gmail.com> writes:

> Sure thing.  I'll include this change when pushing to origin.

For the record, here's a new version of the patch with the two suggested
improvements (put "warning:" in the warning message, and redirect
superfluous output to /dev/null).

-- 
Chris

[-- Attachment #1.2: 0002-tests-Add-tests-for-guix-pack.patch --]
[-- Type: text/x-patch, Size: 12366 bytes --]

From dcb928d92bf92ef5ceff94501b91f98ed28a4226 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Tue, 20 Feb 2018 02:17:54 +0100
Subject: [PATCH 2/7] tests: Add tests for "guix pack".

* guix/scripts/pack.scm (%compressors) <bootstrap-xz>: New compressor.
  (%options) <--bootstrap>: New option.
  (show-help): Document the new --bootstrap option.
  (guix-pack): When --bootstrap is specified, use the bootstrap Guile,
  tar, and xz to build the pack, and do not use any profile hooks or
  locales.
* doc/guix.texi (Invoking guix pull): Document the new --bootstrap
  option.
* tests/guix-pack.sh: New file.
* Makefile.am (SH_TESTS): Add guix-pack.sh.
* gnu/packages/package-management.scm (guix) <inputs>: Add util-linux.
---
 Makefile.am                         |  1 +
 doc/guix.texi                       |  6 ++-
 gnu/packages/package-management.scm |  2 +
 guix/scripts/pack.scm               | 61 +++++++++++++++++++++---------
 tests/guix-pack.sh                  | 74 +++++++++++++++++++++++++++++++++++++
 5 files changed, 126 insertions(+), 18 deletions(-)
 create mode 100644 tests/guix-pack.sh

diff --git a/Makefile.am b/Makefile.am
index 6556799e6..637c934ed 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -374,6 +374,7 @@ SH_TESTS =					\
   tests/guix-download.sh			\
   tests/guix-gc.sh				\
   tests/guix-hash.sh				\
+  tests/guix-pack.sh				\
   tests/guix-package.sh				\
   tests/guix-package-net.sh			\
   tests/guix-system.sh				\
diff --git a/doc/guix.texi b/doc/guix.texi
index d3a7908f9..792539a12 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23,7 +23,7 @@ Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
 Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@*
 Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@*
 Copyright @copyright{} 2016 Ben Woodcroft@*
-Copyright @copyright{} 2016, 2017 Chris Marusich@*
+Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@*
 Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@*
 Copyright @copyright{} 2016 John Darrington@*
 Copyright @copyright{} 2016, 2017 ng0@*
@@ -2899,6 +2899,10 @@ added to it or removed from it after extraction of the pack.
 
 One use case for this is the Guix self-contained binary tarball
 (@pxref{Binary Installation}).
+
+@item --bootstrap
+Use the bootstrap binaries to build the pack.  This option is only
+useful to Guix developers.
 @end table
 
 In addition, @command{guix pack} supports all the common build options
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 709cdfd0f..a90ba7a21 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -257,6 +257,8 @@
          ;; Many tests rely on the 'guile-bootstrap' package, which is why we
          ;; have it here.
          ("boot-guile" ,(bootstrap-guile-origin (%current-system)))
+         ;; Some of the tests use "unshare" when it is available.
+         ("util-linux" ,util-linux)
          ,@(if (and (not (%current-target-system))
                     (string=? (%current-system) "x86_64-linux"))
                `(("boot-guile/i686" ,(bootstrap-guile-origin "i686-linux")))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 59dd117ed..64ed44460 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,7 +34,9 @@
   #:use-module (guix derivations)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
+  #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages guile)
   #:autoload   (gnu packages base) (tar)
   #:autoload   (gnu packages package-management) (guix)
   #:autoload   (gnu packages gnupg) (libgcrypt)
@@ -63,6 +66,8 @@
                     #~(#+(file-append lzip "/bin/lzip") "-9"))
         (compressor "xz"    ".xz"
                     #~(#+(file-append xz "/bin/xz") "-e -T0"))
+        (compressor "bootstrap-xz" ".xz"
+                    #~(#+(file-append %bootstrap-xz "/bin/xz") "-e -T0"))
         (compressor "bzip2" ".bz2"
                     #~(#+(file-append bzip2 "/bin/bzip2") "-9"))
         (compressor "none" "" #f)))
@@ -325,6 +330,9 @@ the image."
          (option '("localstatedir") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'localstatedir? #t result)))
+         (option '("bootstrap") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'bootstrap? #t result)))
 
          (append %transformation-options
                  %standard-build-options)))
@@ -352,6 +360,8 @@ Create a bundle of PACKAGE.\n"))
   -m, --manifest=FILE    create a pack with the manifest from FILE"))
   (display (G_ "
       --localstatedir    include /var/guix in the resulting pack"))
+  (display (G_ "
+      --bootstrap        use the bootstrap binaries to build the pack"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -393,28 +403,43 @@ Create a bundle of PACKAGE.\n"))
        (else (packages->manifest packages)))))
 
   (with-error-handling
-    (parameterize ((%graft? (assoc-ref opts 'graft?)))
-      (let* ((dry-run?    (assoc-ref opts 'dry-run?))
-             (manifest    (manifest-from-args opts))
-             (pack-format (assoc-ref opts 'format))
-             (name        (string-append (symbol->string pack-format)
-                                         "-pack"))
-             (target      (assoc-ref opts 'target))
-             (compressor  (assoc-ref opts 'compressor))
-             (symlinks    (assoc-ref opts 'symlinks))
-             (build-image (match (assq-ref %formats pack-format)
-                            ((? procedure? proc) proc)
-                            (#f
-                             (leave (G_ "~a: unknown pack format")
-                                    format))))
-             (localstatedir? (assoc-ref opts 'localstatedir?)))
-        (with-store store
+    (let* ((dry-run?    (assoc-ref opts 'dry-run?))
+           (manifest    (manifest-from-args opts))
+           (pack-format (assoc-ref opts 'format))
+           (name        (string-append (symbol->string pack-format)
+                                       "-pack"))
+           (target      (assoc-ref opts 'target))
+           (bootstrap?  (assoc-ref opts 'bootstrap?))
+           (compressor  (if bootstrap?
+                            (lookup-compressor "bootstrap-xz")
+                            (assoc-ref opts 'compressor)))
+           (tar         (if bootstrap?
+                            %bootstrap-tar
+                            tar))
+           (symlinks    (assoc-ref opts 'symlinks))
+           (build-image (match (assq-ref %formats pack-format)
+                          ((? procedure? proc) proc)
+                          (#f
+                           (leave (G_ "~a: unknown pack format")
+                                  format))))
+           (localstatedir? (assoc-ref opts 'localstatedir?)))
+      (with-store store
+        (parameterize ((%graft? (assoc-ref opts 'graft?))
+                       (%guile-for-build (package-derivation
+                                          store
+                                          (if (assoc-ref opts 'bootstrap?)
+                                              %bootstrap-guile
+                                              (canonical-package guile-2.2)))))
           ;; Set the build options before we do anything else.
           (set-build-options-from-command-line store opts)
 
           (run-with-store store
             (mlet* %store-monad ((profile (profile-derivation
                                            manifest
+                                           #:hooks (if bootstrap?
+                                                       '()
+                                                       %default-profile-hooks)
+                                           #:locales? (not bootstrap?)
                                            #:target target))
                                  (drv (build-image name profile
                                                    #:target
@@ -424,7 +449,9 @@ Create a bundle of PACKAGE.\n"))
                                                    #:symlinks
                                                    symlinks
                                                    #:localstatedir?
-                                                   localstatedir?)))
+                                                   localstatedir?
+                                                   #:tar
+                                                   tar)))
               (mbegin %store-monad
                 (show-what-to-build* (list drv)
                                      #:use-substitutes?
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
new file mode 100644
index 000000000..34692888b
--- /dev/null
+++ b/tests/guix-pack.sh
@@ -0,0 +1,74 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the `guix pack' command-line utility.
+#
+
+guix pack --version
+
+# Use --no-substitutes because we need to verify we can do this ourselves.
+GUIX_BUILD_OPTIONS="--no-substitutes"
+export GUIX_BUILD_OPTIONS
+
+# Build a tarball with no compression.
+guix pack --compression=none --bootstrap guile-bootstrap
+
+# Build a tarball (with compression).
+guix pack --bootstrap guile-bootstrap
+
+# Build a tarball with a symlink.
+the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
+
+is_available () {
+    # Use the "type" shell builtin to see if the program is on PATH.
+    type "$1" > /dev/null
+}
+
+if is_available chroot && is_available unshare; then
+    # Verify we can extract and use it.
+    test_directory="`mktemp -d`"
+    trap 'rm -rf "$test_directory"' EXIT
+    cd "$test_directory"
+    tar -xf "$the_pack"
+    unshare -r chroot . /opt/gnu/bin/guile --version
+    cd -
+else
+    echo "warning: skipping pack verification because chroot or unshare is unavailable" >&2
+fi
+
+# For the tests that build Docker images below, we currently have to use
+# --dry-run because if we don't, there are only two possible cases:
+#
+#     Case 1: We do not use --bootstrap, and the build takes hours to finish
+#             because it needs to build tar etc.
+#
+#     Case 2: We use --bootstrap, and the build fails because the bootstrap
+#             Guile cannot dlopen shared libraries.  Not to mention the fact
+#             that we would still have to build many non-bootstrap inputs
+#             (e.g., guile-json) in order to create the Docker image.
+
+# Build a Docker image.
+guix pack --dry-run --bootstrap -f docker guile-bootstrap
+
+# Build a Docker image with a symlink.
+guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
+
+# Build a tarball pack of cross-compiled software.  Use coreutils because
+# guile-bootstrap is not intended to be cross-compiled.
+guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
-- 
2.15.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 121 bytes --]

> I understand.  It isn't hard to fix, so here's a new patch that adds
> correct licenses.  How does it look?

LGTM!

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30572] [PATCH 6/7] system: Add "guix system docker-image" command.

[Ludovic Courtès]

Hi Chris,

Chris Marusich <cmmarusich@gmail.com> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>>> +  (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))
>>
>> I think we can use ‘guile-json’ unconditionally here.
>
> Good point.  Nobody using this new code will be using Guile 2.0,

Specifically, we know that derivations are built with ‘guile-final’,
which is now 2.2.

> so we can just use guile-json unconditionally.  Does that mean we can
> also clean up the same conditional statement from other places in Guix
> code now?

Yes, indeed!

>>> +              (mkdir root-directory)
>>> +              (initialize root-directory)
>>> +              (build-docker-image
>>> +               (string-append "/xchg/" #$name) ;; The output file.
>>> +               (cons* root-directory
>>> +                      (call-with-input-file (string-append "/xchg/" #$graph)
>>> +                        read-reference-graph))
>>> +               #$os-drv
>>> +               #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
>>> +               #:creation-time (make-time time-utc 0 1)
>>> +               #:transformations `((,root-directory -> "")))))))
>>
>> Am I right that the whole point of passing several file names to
>> ‘build-docker-image’ is that here we don’t need to copy the whole store
>> to ‘root-directory’, right?
>
> The primary reason why I made this change was because it was the
> simplest way I could find to re-use the existing code.  The fact that we
> copy less is a nice secondary effect, but it is not the primary reason
> why I structured it this way.  There might be a simpler way to
> accomplish this, but this way works, which I think is a good start.  I
> would like to commit this as-is for now.  If we can figure out a simpler
> way to implement the same logic, I'd be all for it, but it seems tricky.
>
> The original role of the "PATH" argument was surprising (for example, it
> was not actually used for adding any paths to the final Docker image!).
> In addition, the original code assumed that all the paths to add (loaded
> from the "CLOSURE" graph file argument - not from PATH!) are store
> paths, which is not true when creating a GuixSD Docker image (unless we
> try to copy everything created by root-partition-initializer back into
> the store).  So, some of the paths I need to add are store paths, and
> some of them are paths to special files outside the store, like device
> files.  Maybe we can copy all of this (including device files and socket
> files) into a single directory in the store (or outside of the store).
> I don't know.  If it's possible, I agree it would be a nice improvement.
> But I tried various methods, and my latest patch was the simplest method
> I found that worked.  I would definitely be happy if we could simplify
> it even more, but I also want to move forward with this patch series.

I see, thanks for taking the time to explain!

I’m always wary about adding too many options in an interface, but like
you wrote, it may be unavoidable here.

> Is it OK to commit this as-is (with just the guile-json change you
> suggested above)?

Yes, sure; sorry for the extra delay.  We can always adjust later if we
have a better idea.

Thanks a lot for working on this!

Ludo’.

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Ludovic Courtès]

Chris Marusich <cmmarusich@gmail.com> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Chris Marusich <cmmarusich@gmail.com> skribis:
>>
>>> * gnu/packages/bootstrap.scm (bootstrap-binary): New procedure.
>>>   (%bootstrap-bash, %bootstrap-mkdir, %bootstrap-tar, %bootstrap-xz):
>>>   Use it to create these new packages, and export them.
>>
>> For ‘guix pack --bootstrap’, I believe we could avoid defining these
>> packages and simply use ‘%bootstrap-coreutils&co’ when ‘--bootstrap’ is
>> used.
>>
>> Would that work for you?
>>
>> I’m asking because we may not keep these 4 binaries around forever.
>
> %bootstrap-coreutils&co requires a network connection to build.  Is it
> OK to use it in tests even though it requires a network connection?  If
> it's OK, then I'll use it, but I thought we wanted to avoid relying on a
> network connection in tests, which is why I defined new packages that do
> not rely on the network.

Oh, I see.  I think it’s OK to use ‘bootstrap-coreutils&co’
nevertheless, and to simply check for networking in the test, as done in
tests/guix-package-net.sh and tests/guix-environment.sh.

The downside is that those tests will indeed require networking (though
they remain cheap).  The upside is that we don’t clutter the package set
with “weird” packages.  :-)

Another option would be to define these packages in a temporary file in
the test and add that to GUIX_PACKAGE_PATH, but maybe that’s overkill…

Thoughts?

Ludo’.

[bug#30572] [PATCH 1/7] gnu: bootstrap: Add trivial packages for bash, mkdir, tar, and xz.

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 605 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

> I think it’s OK to use ‘bootstrap-coreutils&co’ nevertheless, and to
> simply check for networking in the test, as done in
> tests/guix-package-net.sh and tests/guix-environment.sh.
>
> The downside is that those tests will indeed require networking (though
> they remain cheap).  The upside is that we don’t clutter the package set
> with “weird” packages.  :-)

That sounds good to me!  I agree it's best to avoid adding "weird"
packages.  I'll remove this patch from the series, then, and update
patch #2 appropriately.

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Chris Marusich]

[-- Attachment #1.1: Type: text/plain, Size: 648 bytes --]

Chris Marusich <cmmarusich@gmail.com> writes:

> Chris Marusich <cmmarusich@gmail.com> writes:
>
>> Sure thing.  I'll include this change when pushing to origin.
>
> For the record, here's a new version of the patch with the two suggested
> improvements (put "warning:" in the warning message, and redirect
> superfluous output to /dev/null).

And here is another version that (1) uses the existing
%bootstrap-coreutils&co package, and (2) skips the test when no network
connection is available.

Let me know if you think this is good, and I'll go ahead and push the
entire patch series.  Thank you for your feedback!

-- 
Chris

[-- Attachment #1.2: 0001-tests-Add-tests-for-guix-pack.patch --]
[-- Type: text/x-patch, Size: 12610 bytes --]

From 4385831672436b2339f7a5da9f45f429dc3178dc Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Sun, 11 Mar 2018 01:13:01 +0100
Subject: [PATCH 1/6] tests: Add tests for "guix pack".

* guix/scripts/pack.scm (bootstrap-xz): New variable.
  (%options) <--bootstrap>: New option.
  (show-help): Document the new --bootstrap option.
  (guix-pack): When --bootstrap is specified, use the bootstrap Guile,
  tar, and xz to build the pack, and do not use any profile hooks or
  locales.
* doc/guix.texi (Invoking guix pull): Document the new --bootstrap
  option.
* tests/guix-pack.sh: New file.
* Makefile.am (SH_TESTS): Add guix-pack.sh.
* gnu/packages/package-management.scm (guix) <inputs>: Add util-linux.
---
 Makefile.am                         |  1 +
 doc/guix.texi                       |  6 ++-
 gnu/packages/package-management.scm |  2 +
 guix/scripts/pack.scm               | 64 +++++++++++++++++++++--------
 tests/guix-pack.sh                  | 80 +++++++++++++++++++++++++++++++++++++
 5 files changed, 135 insertions(+), 18 deletions(-)
 create mode 100644 tests/guix-pack.sh

diff --git a/Makefile.am b/Makefile.am
index 6556799e6..637c934ed 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -374,6 +374,7 @@ SH_TESTS =					\
   tests/guix-download.sh			\
   tests/guix-gc.sh				\
   tests/guix-hash.sh				\
+  tests/guix-pack.sh				\
   tests/guix-package.sh				\
   tests/guix-package-net.sh			\
   tests/guix-system.sh				\
diff --git a/doc/guix.texi b/doc/guix.texi
index d3a7908f9..792539a12 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23,7 +23,7 @@ Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
 Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@*
 Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@*
 Copyright @copyright{} 2016 Ben Woodcroft@*
-Copyright @copyright{} 2016, 2017 Chris Marusich@*
+Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@*
 Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@*
 Copyright @copyright{} 2016 John Darrington@*
 Copyright @copyright{} 2016, 2017 ng0@*
@@ -2899,6 +2899,10 @@ added to it or removed from it after extraction of the pack.
 
 One use case for this is the Guix self-contained binary tarball
 (@pxref{Binary Installation}).
+
+@item --bootstrap
+Use the bootstrap binaries to build the pack.  This option is only
+useful to Guix developers.
 @end table
 
 In addition, @command{guix pack} supports all the common build options
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 709cdfd0f..a90ba7a21 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -257,6 +257,8 @@
          ;; Many tests rely on the 'guile-bootstrap' package, which is why we
          ;; have it here.
          ("boot-guile" ,(bootstrap-guile-origin (%current-system)))
+         ;; Some of the tests use "unshare" when it is available.
+         ("util-linux" ,util-linux)
          ,@(if (and (not (%current-target-system))
                     (string=? (%current-system) "x86_64-linux"))
                `(("boot-guile/i686" ,(bootstrap-guile-origin "i686-linux")))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 59dd117ed..0ec1ef4d2 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,7 +34,9 @@
   #:use-module (guix derivations)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
+  #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages guile)
   #:autoload   (gnu packages base) (tar)
   #:autoload   (gnu packages package-management) (guix)
   #:autoload   (gnu packages gnupg) (libgcrypt)
@@ -67,6 +70,11 @@
                     #~(#+(file-append bzip2 "/bin/bzip2") "-9"))
         (compressor "none" "" #f)))
 
+;; This one is only for use in this module, so don't put it in %compressors.
+(define bootstrap-xz
+  (compressor "bootstrap-xz" ".xz"
+              #~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e -T0")))
+
 (define (lookup-compressor name)
   "Return the compressor object called NAME.  Error out if it could not be
 found."
@@ -325,6 +333,9 @@ the image."
          (option '("localstatedir") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'localstatedir? #t result)))
+         (option '("bootstrap") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'bootstrap? #t result)))
 
          (append %transformation-options
                  %standard-build-options)))
@@ -352,6 +363,8 @@ Create a bundle of PACKAGE.\n"))
   -m, --manifest=FILE    create a pack with the manifest from FILE"))
   (display (G_ "
       --localstatedir    include /var/guix in the resulting pack"))
+  (display (G_ "
+      --bootstrap        use the bootstrap binaries to build the pack"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -393,28 +406,43 @@ Create a bundle of PACKAGE.\n"))
        (else (packages->manifest packages)))))
 
   (with-error-handling
-    (parameterize ((%graft? (assoc-ref opts 'graft?)))
-      (let* ((dry-run?    (assoc-ref opts 'dry-run?))
-             (manifest    (manifest-from-args opts))
-             (pack-format (assoc-ref opts 'format))
-             (name        (string-append (symbol->string pack-format)
-                                         "-pack"))
-             (target      (assoc-ref opts 'target))
-             (compressor  (assoc-ref opts 'compressor))
-             (symlinks    (assoc-ref opts 'symlinks))
-             (build-image (match (assq-ref %formats pack-format)
-                            ((? procedure? proc) proc)
-                            (#f
-                             (leave (G_ "~a: unknown pack format")
-                                    format))))
-             (localstatedir? (assoc-ref opts 'localstatedir?)))
-        (with-store store
+    (let* ((dry-run?    (assoc-ref opts 'dry-run?))
+           (manifest    (manifest-from-args opts))
+           (pack-format (assoc-ref opts 'format))
+           (name        (string-append (symbol->string pack-format)
+                                       "-pack"))
+           (target      (assoc-ref opts 'target))
+           (bootstrap?  (assoc-ref opts 'bootstrap?))
+           (compressor  (if bootstrap?
+                            bootstrap-xz
+                            (assoc-ref opts 'compressor)))
+           (tar         (if bootstrap?
+                            %bootstrap-coreutils&co
+                            tar))
+           (symlinks    (assoc-ref opts 'symlinks))
+           (build-image (match (assq-ref %formats pack-format)
+                          ((? procedure? proc) proc)
+                          (#f
+                           (leave (G_ "~a: unknown pack format")
+                                  format))))
+           (localstatedir? (assoc-ref opts 'localstatedir?)))
+      (with-store store
+        (parameterize ((%graft? (assoc-ref opts 'graft?))
+                       (%guile-for-build (package-derivation
+                                          store
+                                          (if (assoc-ref opts 'bootstrap?)
+                                              %bootstrap-guile
+                                              (canonical-package guile-2.2)))))
           ;; Set the build options before we do anything else.
           (set-build-options-from-command-line store opts)
 
           (run-with-store store
             (mlet* %store-monad ((profile (profile-derivation
                                            manifest
+                                           #:hooks (if bootstrap?
+                                                       '()
+                                                       %default-profile-hooks)
+                                           #:locales? (not bootstrap?)
                                            #:target target))
                                  (drv (build-image name profile
                                                    #:target
@@ -424,7 +452,9 @@ Create a bundle of PACKAGE.\n"))
                                                    #:symlinks
                                                    symlinks
                                                    #:localstatedir?
-                                                   localstatedir?)))
+                                                   localstatedir?
+                                                   #:tar
+                                                   tar)))
               (mbegin %store-monad
                 (show-what-to-build* (list drv)
                                      #:use-substitutes?
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
new file mode 100644
index 000000000..681faf80a
--- /dev/null
+++ b/tests/guix-pack.sh
@@ -0,0 +1,80 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the `guix pack' command-line utility.
+#
+
+# A network connection is required to build %bootstrap-coreutils&co,
+# which is required to run these tests with the --bootstrap option.
+if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null; then
+    exit 77
+fi
+
+guix pack --version
+
+# Use --no-substitutes because we need to verify we can do this ourselves.
+GUIX_BUILD_OPTIONS="--no-substitutes"
+export GUIX_BUILD_OPTIONS
+
+# Build a tarball with no compression.
+guix pack --compression=none --bootstrap guile-bootstrap
+
+# Build a tarball (with compression).
+guix pack --bootstrap guile-bootstrap
+
+# Build a tarball with a symlink.
+the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
+
+is_available () {
+    # Use the "type" shell builtin to see if the program is on PATH.
+    type "$1" > /dev/null
+}
+
+if is_available chroot && is_available unshare; then
+    # Verify we can extract and use it.
+    test_directory="`mktemp -d`"
+    trap 'rm -rf "$test_directory"' EXIT
+    cd "$test_directory"
+    tar -xf "$the_pack"
+    unshare -r chroot . /opt/gnu/bin/guile --version
+    cd -
+else
+    echo "warning: skipping pack verification because chroot or unshare is unavailable" >&2
+fi
+
+# For the tests that build Docker images below, we currently have to use
+# --dry-run because if we don't, there are only two possible cases:
+#
+#     Case 1: We do not use --bootstrap, and the build takes hours to finish
+#             because it needs to build tar etc.
+#
+#     Case 2: We use --bootstrap, and the build fails because the bootstrap
+#             Guile cannot dlopen shared libraries.  Not to mention the fact
+#             that we would still have to build many non-bootstrap inputs
+#             (e.g., guile-json) in order to create the Docker image.
+
+# Build a Docker image.
+guix pack --dry-run --bootstrap -f docker guile-bootstrap
+
+# Build a Docker image with a symlink.
+guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
+
+# Build a tarball pack of cross-compiled software.  Use coreutils because
+# guile-bootstrap is not intended to be cross-compiled.
+guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
-- 
2.15.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Ludovic Courtès]

Hello Chris!

Chris Marusich <cmmarusich@gmail.com> skribis:

> From 4385831672436b2339f7a5da9f45f429dc3178dc Mon Sep 17 00:00:00 2001
> From: Chris Marusich <cmmarusich@gmail.com>
> Date: Sun, 11 Mar 2018 01:13:01 +0100
> Subject: [PATCH 1/6] tests: Add tests for "guix pack".
>
> * guix/scripts/pack.scm (bootstrap-xz): New variable.
>   (%options) <--bootstrap>: New option.
>   (show-help): Document the new --bootstrap option.
>   (guix-pack): When --bootstrap is specified, use the bootstrap Guile,
>   tar, and xz to build the pack, and do not use any profile hooks or
>   locales.
> * doc/guix.texi (Invoking guix pull): Document the new --bootstrap
>   option.
> * tests/guix-pack.sh: New file.
> * Makefile.am (SH_TESTS): Add guix-pack.sh.
> * gnu/packages/package-management.scm (guix) <inputs>: Add util-linux.

Awesome!

[...]

> +if is_available chroot && is_available unshare; then
> +    # Verify we can extract and use it.
> +    test_directory="`mktemp -d`"
> +    trap 'rm -rf "$test_directory"' EXIT
> +    cd "$test_directory"
> +    tar -xf "$the_pack"
> +    unshare -r chroot . /opt/gnu/bin/guile --version
> +    cd -
> +else
> +    echo "warning: skipping pack verification because chroot or unshare is unavailable" >&2
> +fi

I just realized we could unconditionally extra the pack, do

  test -x "$test_directory/opt/gnu/bin/guile"

and keep only the ‘unshare’ bit in the conditional.

But I’m nitpicking, please push, with or without this change!  :-)

Thanks for your patience,
Ludo’.

bug#30572: [PATCH 2/7] tests: Add tests for "guix pack".

[Chris Marusich]

[-- Attachment #1: Type: text/plain, Size: 1241 bytes --]

Hi Ludo and Danny,

I've committed this patch set to master
(8e88f6fa8236a1fe66912957ecacae348355ec15 is the last commit in the
series)!  I'll watch Hydra to make sure it doesn't cause any unexpected
breakage.

ludo@gnu.org (Ludovic Courtès) writes:

>> +if is_available chroot && is_available unshare; then
>> +    # Verify we can extract and use it.
>> +    test_directory="`mktemp -d`"
>> +    trap 'rm -rf "$test_directory"' EXIT
>> +    cd "$test_directory"
>> +    tar -xf "$the_pack"
>> +    unshare -r chroot . /opt/gnu/bin/guile --version
>> +    cd -
>> +else
>> +    echo "warning: skipping pack verification because chroot or unshare is unavailable" >&2
>> +fi
>
> I just realized we could unconditionally extra the pack, do
>
>   test -x "$test_directory/opt/gnu/bin/guile"
>
> and keep only the ‘unshare’ bit in the conditional.
>
> But I’m nitpicking, please push, with or without this change!  :-)

That's a good idea.  I've included that improvement in my changes.

> Thanks for your patience,

Thank you and Danny for taking the time to review this patch series!
Your feedback definitely helped make the code better.

Now I just need to go write a blog post... :-)

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#30572] [PATCH 2/7] tests: Add tests for "guix pack".

[Ludovic Courtès]

Hey Chris,

Chris Marusich <cmmarusich@gmail.com> skribis:

> I've committed this patch set to master
> (8e88f6fa8236a1fe66912957ecacae348355ec15 is the last commit in the
> series)!  I'll watch Hydra to make sure it doesn't cause any unexpected
> breakage.

Woohoo!

> Now I just need to go write a blog post... :-)

Definitely.

Thank you!

Ludo’.