112 lines
3.3 KiB
Scheme
112 lines
3.3 KiB
Scheme
|
; 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")))))
|
||
|
|
|