1 files changed, 111 insertions, 0 deletions
diff --git a/systems/installer.scm b/systems/installer.scm
new file mode 100644
index 0000000..0fa161c
--- /dev/null
+++ b/systems/installer.scm
@@ -0,0 +1,111 @@
+; base system for creating installer images
+
+(use-modules (freya system)
+	     (gnu packages disk)
+	     (gnu packages linux)
+	     (gnu packages cryptsetup)
+	     (gnu packages file-systems)
+	     (gnu services shepherd)
+	     (guix modules)
+	     (gnu))
+
+; copy over installer disk utilites
+
+(define %installer-disk-utilities
+  (list parted gptfdisk ddrescue
+        lvm2-static
+        cryptsetup mdadm
+        dosfstools
+        btrfs-progs
+        e2fsprogs
+        f2fs-tools
+        jfsutils
+        xfsprogs))
+
+; copy over cow store
+
+(define %backing-directory
+  ;; Sub-directory used as the backing store for copy-on-write.
+  "/tmp/guix-inst")
+
+(define cow-store-service-type
+  (shepherd-service-type
+   'cow-store
+   (lambda _
+     (define (import-module? module)
+       ;; Since we don't use deduplication support in 'populate-store', don't
+       ;; import (guix store deduplication) and its dependencies, which
+       ;; includes Guile-Gcrypt.
+       (and (guix-module-name? module)
+            (not (equal? module '(guix store deduplication)))))
+
+     (shepherd-service
+      (requirement '(root-file-system user-processes))
+      (provision '(cow-store))
+      (documentation
+       "Make the store copy-on-write, with writes going to \
+the given target.")
+
+      ;; This is meant to be explicitly started by the user.
+      (auto-start? #f)
+
+      (modules `((gnu build install)
+                 ,@%default-modules))
+      (start
+       (with-imported-modules (source-module-closure
+                               '((gnu build install))
+                               #:select? import-module?)
+         #~(case-lambda
+             ((target)
+              (mount-cow-store target #$%backing-directory)
+              target)
+             (else
+              ;; Do nothing, and mark the service as stopped.
+              #f))))
+      (stop #~(lambda (target)
+                ;; Delete the temporary directory, but leave everything
+                ;; mounted as there may still be processes using it since
+                ;; 'user-processes' doesn't depend on us.  The 'user-file-systems'
+                ;; service will unmount TARGET eventually.
+                (delete-file-recursively
+                 (string-append target #$%backing-directory))))))
+   (description "Make the store copy-on-write, with writes going to \
+the given target.")))
+
+(define (cow-store-service)
+  "Return a service that makes the store copy-on-write, such that writes go to
+the user's target storage device rather than on the RAM disk."
+  ;; See <http://bugs.gnu.org/18061> for the initial report.
+  (service cow-store-service-type 'mooooh!))
+
+; installer system
+
+(operating-system
+  (inherit base-operating-system)
+  (host-name "installer")
+
+  (file-systems
+	(append %base-live-file-systems
+		%base-file-systems))
+
+  (users (list (user-account
+		 (name "root")
+		 (group "root")
+		 (supplementary-groups '("wheel")) ; allow use of sudo
+		 (password "")
+		 (comment "root"))))
+
+  (pam-services
+    ;; Explicitly allow for empty passwords.
+    (base-pam-services #:allow-empty-passwords? #t))
+
+  (packages (append %installer-disk-utilities
+		    %freya-base-packages))
+
+  (services (append %freya-base-services
+		    (list (cow-store-service))))
+
+  (bootloader (bootloader-configuration
+		(bootloader grub-bootloader)
+		(targets '("/dev/sda")))))
+