123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406 |
- (define-module (gnu system install)
- #:use-module (gnu)
- #:use-module (gnu bootloader u-boot)
- #:use-module (guix gexp)
- #:use-module (guix store)
- #:use-module (guix monads)
- #:use-module ((guix store) #:select (%store-prefix))
- #:use-module (gnu services shepherd)
- #:use-module (gnu services ssh)
- #:use-module (gnu packages admin)
- #:use-module (gnu packages bash)
- #:use-module (gnu packages bootloaders)
- #:use-module (gnu packages guile)
- #:use-module (gnu packages linux)
- #:use-module (gnu packages ssh)
- #:use-module (gnu packages cryptsetup)
- #:use-module (gnu packages package-management)
- #:use-module (gnu packages disk)
- #:use-module (gnu packages texinfo)
- #:use-module (gnu packages compression)
- #:use-module (gnu packages nvi)
- #:use-module (ice-9 match)
- #:use-module (srfi srfi-26)
- #:export (installation-os
- beaglebone-black-installation-os))
- (define (log-to-info)
- "Return a script that spawns the Info reader on the right section of the
- manual."
- (program-file "log-to-info"
- #~(begin
-
- (setenv "PATH" (string-append #$gzip "/bin"))
- (execl (string-append #$info-reader "/bin/info") "info"
- "-d" "/run/current-system/profile/share/info"
- "-f" (string-append #$guix "/share/info/guix.info")
- "-n" "System Installation"))))
- (define %backing-directory
-
- "/tmp/guix-inst")
- (define (make-cow-store target)
- "Return a gexp that makes the store copy-on-write, using TARGET as the
- backing store. This is useful when TARGET is on a hard disk, whereas the
- current store is on a RAM disk."
- (define (set-store-permissions directory)
-
- #~(begin
- (chown #$directory 0 30000)
- (chmod #$directory #o1775)))
- #~(begin
-
- (let ((tmpdir (string-append #$target "/tmp")))
- (mkdir-p tmpdir)
- (mount tmpdir "/tmp" "none" MS_BIND))
- (let* ((rw-dir (string-append target #$%backing-directory))
- (work-dir (string-append rw-dir "/../.overlayfs-workdir")))
- (mkdir-p rw-dir)
- (mkdir-p work-dir)
- (mkdir-p "/.rw-store")
- #$(set-store-permissions #~rw-dir)
- #$(set-store-permissions "/.rw-store")
-
- (mount "none" "/.rw-store" "overlay" 0
- (string-append "lowerdir=" #$(%store-prefix) ","
- "upperdir=" rw-dir ","
- "workdir=" work-dir))
- (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
- (rmdir "/.rw-store"))))
- (define cow-store-service-type
- (shepherd-service-type
- 'cow-store
- (lambda _
- (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.")
-
- (auto-start? #f)
- (start #~(case-lambda
- ((target)
- #$(make-cow-store #~target)
- target)
- (else
-
- #f)))
- (stop #~(lambda (target)
-
-
-
-
- (delete-file-recursively
- (string-append target #$%backing-directory))))))))
- (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."
-
- (service cow-store-service-type 'mooooh!))
- (define (/etc/configuration-files _)
- "Return a list of tuples representing configuration templates to add to
- /etc."
- (define (file f)
- (local-file (string-append "examples/" f)))
- (define directory
- (computed-file "configuration-templates"
- (with-imported-modules '((guix build utils))
- #~(begin
- (mkdir #$output)
- (for-each (lambda (file target)
- (copy-file file
- (string-append #$output "/"
- target)))
- '(#$(file "bare-bones.tmpl")
- #$(file "beaglebone-black.tmpl")
- #$(file "desktop.tmpl")
- #$(file "lightweight-desktop.tmpl"))
- '("bare-bones.scm"
- "beaglebone-black.scm"
- "desktop.scm"
- "lightweight-desktop.scm"))
- #t))))
- `(("configuration" ,directory)))
- (define configuration-template-service-type
- (service-type (name 'configuration-template)
- (extensions
- (list (service-extension etc-service-type
- /etc/configuration-files)))))
- (define %configuration-template-service
- (service configuration-template-service-type #t))
- (define %nscd-minimal-caches
-
- (list (nscd-cache (database 'hosts)
- (positive-time-to-live (* 3600 12))
-
-
-
- (negative-time-to-live 0)
- (persistent? #f)
- (max-database-size (* 5 (expt 2 20))))))
- (define %installation-services
-
- (let ((motd (plain-file "motd" "
- \x1b[1;37mWelcome to the installation of the Guix System Distribution!\x1b[0m
- \x1b[2mThere is NO WARRANTY, to the extent permitted by law. In particular, you may
- LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore,
- it is 'beta' software, so it may contain bugs.
- You have been warned. Thanks for being so brave.\x1b[0m
- ")))
- (define (normal-tty tty)
- (mingetty-service (mingetty-configuration (tty tty)
- (auto-login "root")
- (login-pause? #t))))
- (define bare-bones-os
- (load "examples/bare-bones.tmpl"))
- (list (mingetty-service (mingetty-configuration
- (tty "tty1")
- (auto-login "root")))
- (login-service (login-configuration
- (motd motd)))
-
-
-
- (mingetty-service (mingetty-configuration
- (tty "tty2")
- (auto-login "guest")
- (login-program (log-to-info))))
-
- %configuration-template-service
-
- (normal-tty "tty3")
- (normal-tty "tty4")
- (normal-tty "tty5")
- (normal-tty "tty6")
-
- (syslog-service)
-
-
-
- (guix-service (guix-configuration (authorize-key? #t)))
-
-
-
- (udev-service #:rules (list lvm2 crda))
-
-
- (cow-store-service)
-
-
-
- (service console-font-service-type
- (map (lambda (tty)
- (cons tty "lat9u-16"))
- '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
-
- (gpm-service)
-
- (service openssh-service-type
- (openssh-configuration
- (port-number 22)
- (permit-root-login #t)
-
-
- (allow-empty-passwords? #f)
- (password-authentication? #t)
-
- (%auto-start? #f)))
-
-
- (nscd-service (nscd-configuration
- (caches %nscd-minimal-caches)))
-
-
- (service special-files-service-type
- `(("/bin/sh" ,(file-append (canonical-package bash)
- "/bin/sh"))))
-
-
-
-
- (service gc-root-service-type
- (list bare-bones-os
- glibc-utf8-locales
- texinfo
- (canonical-package guile-2.2))))))
- (define %issue
-
- "
- \x1b[1;37mThis is an installation image of the GNU system. Welcome.\x1b[0m
- \x1b[1;33mUse Alt-F2 for documentation.\x1b[0m
- ")
- (define installation-os
-
- (operating-system
- (host-name "gnu")
- (timezone "Europe/Paris")
- (locale "en_US.utf8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (target "/dev/sda")))
- (file-systems
-
-
- (cons* (file-system
- (mount-point "/")
- (device "GuixSD_image")
- (title 'label)
- (type "ext4"))
-
-
-
-
-
-
- (file-system
- (mount-point "/tmp")
- (device "none")
- (title 'device)
- (type "tmpfs")
- (check? #f))
-
-
- (list %pseudo-terminal-file-system
- %shared-memory-file-system
- %immutable-store)))
- (users (list (user-account
- (name "guest")
- (group "users")
- (supplementary-groups '("wheel"))
- (password "")
- (comment "Guest of GNU")
- (home-directory "/home/guest"))))
- (issue %issue)
- (services %installation-services)
-
-
- (setuid-programs (list (file-append shadow "/bin/passwd")))
- (pam-services
-
- (base-pam-services #:allow-empty-passwords? #t))
- (packages (cons* (canonical-package glibc)
- parted gptfdisk ddrescue
- grub
- cryptsetup
- mdadm
- dosfstools
- btrfs-progs
- openssh
- wireless-tools iw wpa-supplicant-minimal iproute
-
-
-
-
- bash-completion
- nvi
- %base-packages))))
- (define beaglebone-black-installation-os
- (operating-system
- (inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader u-boot-beaglebone-black-bootloader)
- (target "/dev/sda")))
- (kernel linux-libre)
- (initrd (lambda (fs . rest)
- (apply base-initrd fs
-
- #:extra-modules (list "omap_hsmmc")
- rest)))
- (services (append
-
-
- (list (agetty-service
- (agetty-configuration
- (extra-options '("-L"))
- (baud-rate "115200")
- (term "vt100")
- (tty "ttyO0"))))
- (operating-system-user-services installation-os)))))
- installation-os
|