Re: Guix on macOS

[Chris Marusich <cmmarusich@gmail.com>]

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

Hi Guix,

I've looked further into the possibility of running Guix on macOS.  I'm
convinced now that running Guix natively on macOS (i.e., compiling it
for x86_64-apple-darwin) isn't a feasible goal at this time.  GNU libc
doesn't target Darwin, so it can't be used as-is to compile programs to
run on macOS, and as Ricardo mentioned, it seems there are currently no
viable ports of GNU libc that target Darwin.  In addition, I checked the
NixPkgs source code and spoke with a Nix developer who helped get Nix
working on macOS, and I can confirm that the following are true:

* In NixPkgs, some impurities are explicitly allowed here and there to
  make Darwin builds succeed.  Specifically, certain macOS system files
  are exposed to and used by the build processes.  This means that not
  all Darwin package builds are pure, and I'm not sure what the
  licensing implications might be.

* Nix's Darwin bootstrap tools are maintained in Nix, but they aren't
  cross-compiled (e.g., from x86_64-linux).  They're built from a
  previous generation of the stdenv for Darwin.  I suspect, but do not
  know for sure, that originally the bootstrap binaries were compiled
  using the usual impure and non-free macOS toolchain.

* Nix doesn't use GNU libc for Darwin software.  Instead, it uses
  libSystem's libc.  In addition, I'm told that Nix relies pretty
  heavily on opensource.apple.com, and I'm told that many of those
  pieces of software don't have clear free software analogs.

For these reasons, it seems infeasible at this time to port Guix to
macOS natively while satisfying the two criteria that Ludo mentioned,
which were: "(1) this can be achieved in a maintainable way, and (2) the
targeted user-land software is free and buildable from source."  That's
unfortunate, but at least I did my homework, and now we know.

In lieu of running Guix natively on macOS, I'm now interested in adding
a "guix system docker-image" feature which would enable us to invoke a
command like "guix system docker-image my-os-config.scm" and receive as
output a docker image containing the GuixSD system defined by
my-os-config.scm.  This seems potentially very useful.  If we had this
feature, then anyone capable of running Docker images could run GuixSD.
This is similar to making a VM image or a regular disk image.  Docker is
popular, so I think it makes sense to make it easy for people to
experiment with GuixSD using Docker, too.

Personally, I'd like to empower people to use GuixSD on macOS in a
docker container to manage installed software in a way that is,
hopefully, almost as good as running Guix natively.  However, I can
imagine other uses for this feature, as well.  If you're a DevOps shop
and you're already heavily invested in the Docker ecosystem, this could
make it possible to deploy GuixSD easily in your environment.  For the
use case of managing software on a laptop, I think it'd be OK to mutate
the state of a GuixSD docker container by installing packages in it.
Hopefully the container can be integrated well enough to make it feel
like you've actually installed Guix on your laptop.  For a production
service, though, I would not want to deploy stateful Docker containers;
I'd prefer to use stateless containers if possible.

If we had the ability to build a docker image from a GuixSD operating
system configuration file, then it could potentially accommodate both
needs: a person could use a stateful GuixSD docker image on their laptop
for day to day tasks, and they could also leverage their company's
existing Docker infrastructure to deploy (hopefully stateless) GuixSD
docker images to production.  Instead of writing a Dockerfile based on a
base image blob that might be difficult to audit, validate, or
reproduce, and instead of compounding the issue by adding "layers" on
top of your base image blob like Docker encourages its users to do,
you'd write a GuixSD operating system configuration file to
declaratively define the service(s) in your GuixSD docker image.  You
would then build precisely the image you want, every time, using Guix.
You would then deploy it using your existing Docker tools.  This is
nothing new for GuixSD users, really, but Docker is popular and being
used today by many companies and individuals, so it might be a good way
to encourage adoption of GuixSD, Guix, the functional software
deployment model, and free software.

I've tried to implement such a feature, but I'm stuck.  In the attached
patch, I've added a command that lets you do "guix system disk-image -t
docker my-config.scm".  I've tried to merge some of the logic for
running a gexp in a linux vm with the logic for building a docker
container, but I can't get it to work.  I can successfully build Guix
with "make -j", but when I run it, I get the following error:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix system disk-image -t docker gnu/system/install.scm
...
Welcome, this is GNU's early boot Guile.
Use '--repl' for an initrd REPL.

loading kernel modules...
[    1.151988] usbcore: registered new interface driver usb-storage
[    1.158506] usbcore: registered new interface driver uas
[    1.169030] hidraw: raw HID events driver (C) Jiri Kosina
[    1.174144] usbcore: registered new interface driver usbhid
[    1.175537] usbhid: USB HID core driver
[    1.221664] isci: Intel(R) C600 SAS Controller Driver - version 1.2.0
[    1.253086] ACPI: PCI Interrupt Link [LNKC] enabled at IRQ 11
[    1.282881] ACPI: PCI Interrupt Link [LNKD] enabled at IRQ 10
[    1.312644] ACPI: PCI Interrupt Link [LNKA] enabled at IRQ 10
[    1.345843] FS-Cache: Loaded
[    1.362140] 9pnet: Installing 9P2000 support
[    1.366118] 9p: Installing v9fs 9p2000 file system support
[    1.368730] FS-Cache: Netfs '9p' registered for caching
configuring QEMU networking...
loading '/gnu/store/jy509dgcsz82y13fmizv2sqaj90s1vfg-linux-vm-loader'...
ERROR: In procedure dynamic-link:
ERROR: In procedure dynamic-link: file: "/gnu/store/hwygv5jwd47amhp1m67iy3bkvxqjlbhm-libgcrypt-1.8.1/lib/libgcrypt", message: "file not found"

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
GNU Guile 2.2.2
...
--8<---------------cut here---------------end--------------->8---

What's wrong?  How can I fix it?  I'm stuck and need help.

This appears to be an error on the build side, inside of the linux VM.
It seems /gnu/store/...-libgcrypt-1.8.1/lib/libgcrypt.so is not
available to the code running inside the VM.  The shared object file
(with the .so extension) exists in my store on the host side.  As far as
I can tell, I'm correctly adding libgcrypt to the gexp's closure of
inputs, so I don't understand why the error is happening.  Any tips on
how to debug this or fix it would be great.  Part of the reason I'm
stuck might be because I don't really understand how (guix config) is
used or why the (guix docker) module needs to override it.  I just
cargo-culted that part of the code in an attempt to quickly get
something that worked.  I plan to clean up the patch a lot later.

The attached patch should apply cleanly to commit
3b2fa4787938a408fab27ef7b3bc1302b6b6a805.

Thank you,

-- 
Chris

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Try-to-build-a-GuixSD-docker-image-currently-fails.patch --]
[-- Type: text/x-patch, Size: 14620 bytes --]

From 6f5f43702f10a15f58df386d107d63843f788fe5 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Sat, 21 Oct 2017 14:40:58 -0700
Subject: [PATCH] Try to build a GuixSD docker image - currently fails

---
 gnu/build/linux-boot.scm |   5 +-
 gnu/build/vm.scm         |  14 +++--
 gnu/system/vm.scm        | 158 ++++++++++++++++++++++++++++++++++++++++-------
 guix/docker.scm          |   6 +-
 guix/scripts/pack.scm    |   5 +-
 guix/scripts/system.scm  |   1 +
 6 files changed, 161 insertions(+), 28 deletions(-)

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 3712abe91..37da5b217 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -117,8 +117,9 @@ with the given MAJOR number, starting with MINOR."
                        "/")
                    dir))
 
+  (display "just before dev\n")
   (unless (file-exists? (scope "dev"))
-    (mkdir (scope "dev")))
+    (mkdir (pk (scope "dev"))))
 
   ;; Make the device nodes for SCSI disks.
   (make-disk-device-nodes (scope "dev/sda") 8)
@@ -138,6 +139,7 @@ with the given MAJOR number, starting with MINOR."
   (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2))
 
   ;; Inputs (used by Xorg.)
+  (display "just before dev/input\n")
   (unless (file-exists? (scope "dev/input"))
     (mkdir (scope "dev/input")))
   (mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63))
@@ -171,6 +173,7 @@ with the given MAJOR number, starting with MINOR."
   (chmod (scope "dev/ptmx") #o666)
 
   ;; Create /dev/pts; it will be mounted later, at boot time.
+  (display "just before dev/pts\n")
   (unless (file-exists? (scope "dev/pts"))
     (mkdir (scope "dev/pts")))
 
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 7537f8150..19c47e1ff 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -294,11 +294,14 @@ it, run its initializer, and unmount it."
 (define* (root-partition-initializer #:key (closures '())
                                      copy-closures?
                                      (register-closures? #t)
-                                     system-directory)
+                                     system-directory
+                                     (deduplicate? #t))
   "Return a procedure to initialize a root partition.
 
-If REGISTER-CLOSURES? is true, register all of CLOSURES is the partition's
-store.  If COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
+If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's
+store.  If DEDUPLICATE? is true, then also deduplicate files common to
+CLOSURES and the rest of the store when registering the closures.  If
+COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
 SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
   (lambda (target)
     (define target-store
@@ -317,13 +320,16 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
       (unless copy-closures?
         ;; XXX: 'guix-register' wants to palpate the things it registers, so
         ;; bind-mount the store on the target.
+        (display "making target store directory\n")
         (mkdir-p target-store)
+        (display "bind-mounting\n")
         (mount (%store-directory) target-store "" MS_BIND))
 
       (display "registering closures...\n")
       (for-each (lambda (closure)
                   (register-closure target
-                                    (string-append "/xchg/" closure)))
+                                    (string-append "/xchg/" closure)
+                                    #:deduplicate? deduplicate?))
                 closures)
       (unless copy-closures?
         (umount target-store)))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 3127b305e..5e3db23b3 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -22,6 +22,7 @@
 
 (define-module (gnu system vm)
   #:use-module (guix config)
+  #:use-module (guix docker)
   #:use-module (guix store)
   #:use-module (guix gexp)
   #:use-module (guix derivations)
@@ -29,13 +30,16 @@
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix modules)
+  #:use-module (guix scripts pack)
 
   #:use-module ((gnu build vm)
                 #:select (qemu-command))
   #:use-module (gnu packages base)
+
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages cdrom)
   #:use-module (gnu packages guile)
+  #:autoload   (gnu packages gnupg) (libgcrypt)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages less)
@@ -349,6 +353,111 @@ the image."
    #:disk-image-format disk-image-format
    #:references-graphs inputs))
 
+(define* (os-docker-image #:key
+                          (name "guixsd-docker-image")
+                          os-drv
+                          (system (%current-system))
+                          (compressor (first %compressors))
+                          localstatedir?
+                          (symlinks '())
+                          (tar tar)
+                          (register-closures? #t)
+                          (inputs '()))
+  "Build a docker image.  OS-DRV is a derivation which builds the
+operating system profile."
+    ;; FIXME: Honor LOCALSTATEDIR?.
+  (define not-config?
+    (match-lambda
+      (('guix 'config) #f)
+      (('guix rest ...) #t)
+      (('gnu rest ...) #t)
+      (rest #f)))
+
+  (define config
+    ;; (guix config) module for consumption by (guix gcrypt).
+    (scheme-file "gcrypt-config.scm"
+                 #~(begin
+                     (define-module (guix config)
+                       #:export (%libgcrypt))
+
+                     ;; XXX: Work around <http://bugs.gnu.org/15602>.
+                     (eval-when (expand load eval)
+                       (define %libgcrypt
+                         #+(file-append libgcrypt "/lib/libgcrypt"))))))
+
+  (define json
+    ;; Pick the guile-json package that corresponds to the Guile used to build
+    ;; derivations.
+    (if (string-prefix? "2.0" (package-version (default-guile)))
+        guile2.0-json
+        guile-json))
+  
+  (let ((name (string-append name ".tar" (compressor-extension compressor))))
+    (define build
+      (with-imported-modules `(,@(source-module-closure '((guix docker)
+                                                          (gnu build vm)
+                                                          (guix build utils)
+                                                          (guix build syscalls))
+                                                      #:select? not-config?)
+                             ((guix config) => ,config))
+      #~(begin
+          ;; Guile-JSON is required by (guix docker).
+          (add-to-load-path
+           (string-append #+json "/share/guile/site/"
+                          (effective-version)))
+         (use-modules (gnu build vm)
+                      (guix build utils)
+                      (guix build syscalls)
+                      (srfi srfi-26)
+                      (ice-9 match)
+                      (guix docker)
+                      (srfi srfi-19))
+
+         (let* ((inputs
+                 '#$(append (list tree parted e2fsprogs dosfstools tar)
+                            (map canonical-package
+                                 (list sed grep coreutils findutils gawk))
+                            (if register-closures? (list guix) '())))
+
+                 ;; This variable is unused but allows us to add INPUTS-TO-COPY
+                 ;; as inputs.
+                 (to-register
+                  '#$(map (match-lambda
+                            ((name thing) thing)
+                            ((name thing output) `(,thing ,output)))
+                          inputs))
+                 (graphs '#$(match inputs
+                              (((names . _) ...)
+                                names)))
+                 (initialize (root-partition-initializer
+                               #:closures graphs
+                               #:copy-closures? #f
+                               #:register-closures? #$register-closures?
+                               #:system-directory #$os-drv
+                               #:deduplicate? #f))
+                 (root "/tmp/root"))
+
+           (display "before set path\n")
+           (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           (system* "id")
+           (display "before initializing root\n")
+           (mkdir-p root)
+           (initialize root)
+           (display "after initializing root\n")
+           (build-docker-image (string-append "/xchg/" #$name)
+                               #$os-drv
+                               #:closure "system"
+                               #:symlinks '#$symlinks
+                               #:compressor '#$(compressor-command compressor)
+                               #:creation-time (make-time time-utc 0 1))))))
+  (expression->derivation-in-linux-vm
+   name
+   build
+   #:system system
+   #:make-disk-image? #f
+   #:single-file-output? #t
+   #:references-graphs inputs)))
+
 \f
 ;;;
 ;;; VM and disk images.
@@ -443,31 +552,38 @@ to USB sticks meant to be read-only."
 
     (mlet* %store-monad ((os-drv   (operating-system-derivation os))
                          (bootcfg  (operating-system-bootcfg os)))
-      (if (string=? "iso9660" file-system-type)
-          (iso9660-image #:name name
-                         #:file-system-label root-label
-                         #:file-system-uuid root-uuid
+      (cond ((string=? "iso9660" file-system-type)
+             (iso9660-image #:name name
+                            #:file-system-label root-label
+                            #:file-system-uuid root-uuid
+                            #:os-drv os-drv
+                            #:register-closures? #t
+                            #:bootcfg-drv bootcfg
+                            #:bootloader (bootloader-configuration-bootloader
+                                           (operating-system-bootloader os))
+                            #:inputs `(("system" ,os-drv)
+                                       ("bootcfg" ,bootcfg))))
+            ((string=? "docker")
+             (display "made it to docker image part\n")
+             (os-docker-image #:name name
+                              #:os-drv os-drv
+                              #:register-closures? #t
+                              #:inputs `(("system" ,os-drv))))
+            (else
+             (qemu-image #:name name
                          #:os-drv os-drv
-                         #:register-closures? #t
                          #:bootcfg-drv bootcfg
                          #:bootloader (bootloader-configuration-bootloader
-                                        (operating-system-bootloader os))
+                                       (operating-system-bootloader os))
+                         #:disk-image-size disk-image-size
+                         #:disk-image-format "raw"
+                         #:file-system-type file-system-type
+                         #:file-system-label root-label
+                         #:file-system-uuid root-uuid
+                         #:copy-inputs? #t
+                         #:register-closures? #t
                          #:inputs `(("system" ,os-drv)
-                                    ("bootcfg" ,bootcfg)))
-          (qemu-image #:name name
-                      #:os-drv os-drv
-                      #:bootcfg-drv bootcfg
-                      #:bootloader (bootloader-configuration-bootloader
-                                    (operating-system-bootloader os))
-                      #:disk-image-size disk-image-size
-                      #:disk-image-format "raw"
-                      #:file-system-type file-system-type
-                      #:file-system-label root-label
-                      #:file-system-uuid root-uuid
-                      #:copy-inputs? #t
-                      #:register-closures? #t
-                      #:inputs `(("system" ,os-drv)
-                                 ("bootcfg" ,bootcfg)))))))
+                                    ("bootcfg" ,bootcfg))))))))
 
 (define* (system-qemu-image os
                             #:key
diff --git a/guix/docker.scm b/guix/docker.scm
index 060232148..64d92ce16 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -28,7 +28,8 @@
   #:use-module (srfi srfi-19)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
-  #:export (build-docker-image))
+  #:export (build-docker-image
+            raw-disk-image->docker-image))
 
 ;; Load Guile-JSON at run time to simplify the job of 'imported-modules' & co.
 (module-use! (current-module) (resolve-interface '(json)))
@@ -181,3 +182,6 @@ CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata."
                                     '())
                               ".")))
               (begin (delete-file-recursively directory) #t)))))
+
+(define* (raw-disk-image->docker-image raw-image)
+  (display "Doing the docker stuff!"))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 21fea446a..8d8053fca 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -41,7 +41,10 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
-  #:export (compressor?
+  #:export (%compressors
+            compressor-extension
+            compressor-command
+            compressor?
             lookup-compressor
             self-contained-tarball
             guix-pack))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index e50f1d8ac..392d2a3cc 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -640,6 +640,7 @@ any, are available.  Raise an error if they're not."
      (system-disk-image os
                         #:name (match file-system-type
                                  ("iso9660" "image.iso")
+                                 ("docker" "docker-image")
                                  (_         "disk-image"))
                         #:disk-image-size image-size
                         #:file-system-type file-system-type))))
-- 
2.14.2


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