[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
31/67: installer: Add partitioning support.
|
From: |
guix-commits |
|
Subject: |
31/67: installer: Add partitioning support. |
|
Date: |
Wed, 16 Jan 2019 19:00:40 -0500 (EST) |
civodul pushed a commit to branch wip-newt-installer
in repository guix.
commit 24cf475f4081cb312ff269e18fea74c53fb18b8d
Author: Mathieu Othacehe <address@hidden>
Date: Wed Dec 5 14:57:28 2018 +0900
installer: Add partitioning support.
* gnu/installer.scm (installer-steps): Add partitioning step.
* gnu/installer/newt.scm (newt-installer): Add partition-page field.
* gnu/installer/newt/partition.scm: New file.
* gnu/installer/parted.scm: New file.
* gnu/installer/record (installer): New partition-page field.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add new files.
* po/guix/POTFILES.in: Add new files.
---
gnu/installer.scm | 32 +-
gnu/installer/newt.scm | 5 +
gnu/installer/newt/partition.scm | 706 ++++++++++++++++++++++
gnu/installer/parted.scm | 1210 ++++++++++++++++++++++++++++++++++++++
gnu/installer/record.scm | 3 +
gnu/local.mk | 2 +
po/guix/POTFILES.in | 1 +
7 files changed, 1953 insertions(+), 6 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 29178cb..80b5782 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer)
+ #:use-module (guix discovery)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix modules)
@@ -27,6 +28,7 @@
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages connman)
+ #:use-module (gnu packages disk)
#:use-module (gnu packages guile)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu packages iso-codes)
@@ -172,9 +174,14 @@ selected keymap."
((installer-welcome-page current-installer)
#$(local-file "installer/aux-files/logo.txt")))))
- ;; Ask the user to choose a locale among those supported by the glibc.
- ;; Install the selected locale right away, so that the user may
- ;; benefit from any available translation for the installer messages.
+ ;; Run a partitionment tool allowing the user to modify
+ ;; partition tables, partitions and their mount points.
+ (installer-step
+ (id 'partition)
+ (description (G_ "Partitionment"))
+ (compute (lambda _
+ ((installer-partition-page current-installer))))
+ (configuration-formatter user-partitions->configuration))
;; Ask the user to choose a locale among those supported by
;; the glibc. Install the selected locale right away, so that
@@ -263,18 +270,31 @@ selected keymap."
(define set-installer-path
;; Add the specified binary to PATH for later use by the installer.
#~(let* ((inputs
- '#$(append (list bash connman shadow)
+ '#$(append (list bash ;start subshells
+ connman ;call connmanctl
+ dosfstools ;mkfs.fat
+ e2fsprogs ;mkfs.ext4
+ kbd ;chvt
+ guix ;guix system init call
+ util-linux ;mkwap
+ shadow)
(map canonical-package (list coreutils)))))
(with-output-to-port (%make-void-port "w")
(lambda ()
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
(define steps (installer-steps))
+ (define modules
+ (scheme-modules*
+ (string-append (current-source-directory) "/..")
+ "gnu/installer"))
(define installer-builder
- (with-extensions (list guile-gcrypt guile-newt guile-json)
+ (with-extensions (list guile-gcrypt guile-newt
+ guile-parted guile-bytestructures
+ guile-json)
(with-imported-modules `(,@(source-module-closure
- '((gnu installer newt)
+ `(,@modules
(guix build utils))
#:select? not-config?)
((guix config) => ,(make-config.scm)))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 3192e55..9d92121 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -25,6 +25,7 @@
#:use-module (gnu installer newt locale)
#:use-module (gnu installer newt menu)
#:use-module (gnu installer newt network)
+ #:use-module (gnu installer newt partition)
#:use-module (gnu installer newt services)
#:use-module (gnu installer newt timezone)
#:use-module (gnu installer newt user)
@@ -81,6 +82,9 @@
(define (user-page)
(run-user-page))
+(define (partition-page)
+ (run-partioning-page))
+
(define (services-page)
(run-services-page))
@@ -98,5 +102,6 @@
(timezone-page timezone-page)
(hostname-page hostname-page)
(user-page user-page)
+ (partition-page partition-page)
(services-page services-page)
(welcome-page welcome-page)))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
new file mode 100644
index 0000000..806337a
--- /dev/null
+++ b/gnu/installer/newt/partition.scm
@@ -0,0 +1,706 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <address@hidden>
+;;;
+;;; 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/>.
+
+(define-module (gnu installer newt partition)
+ #:use-module (gnu installer parted)
+ #:use-module (gnu installer steps)
+ #:use-module (gnu installer utils)
+ #:use-module (gnu installer newt page)
+ #:use-module (gnu installer newt utils)
+ #:use-module (guix i18n)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (newt)
+ #:use-module (parted)
+ #:export (run-partioning-page))
+
+(define (button-cancel-action)
+ "Raise the &installer-step-abort condition."
+ (raise
+ (condition
+ (&installer-step-abort))))
+
+(define (run-scheme-page)
+ "Run a page asking the user for a partitioning scheme."
+ (let* ((items
+ '((root . "Everything is one partition")
+ (root-home . "Separate /home partition")))
+ (result (run-listbox-selection-page
+ #:info-text (G_ "Please select a partitioning scheme.")
+ #:title (G_ "Partition scheme")
+ #:listbox-items items
+ #:listbox-item->text cdr
+ #:button-text (G_ "Cancel")
+ #:button-callback-procedure button-cancel-action)))
+ (car result)))
+
+(define (draw-formating-page)
+ "Draw a page to indicate partitions are being formated."
+ (draw-info-page
+ (format #f (G_ "Partition formating is in progress, please wait."))
+ (G_ "Preparing partitions")))
+
+(define (run-device-page devices)
+ "Run a page asking the user to select a device among those in the given
+DEVICES list."
+ (define (device-items)
+ (map (lambda (device)
+ `(,device . ,(device-description device)))
+ devices))
+
+ (let* ((result (run-listbox-selection-page
+ #:info-text (G_ "Please select a disk.")
+ #:title (G_ "Disk")
+ #:listbox-items (device-items)
+ #:listbox-item->text cdr
+ #:button-text (G_ "Cancel")
+ #:button-callback-procedure button-cancel-action))
+ (device (car result)))
+ device))
+
+(define (run-label-page button-callback)
+ "Run a page asking the user to select a partition table label."
+ (run-listbox-selection-page
+ #:info-text (G_ "Select a new partition table type. \
+Be careful, all data on the disk will be lost.")
+ #:title (G_ "Partition table")
+ #:listbox-items '("msdos" "gpt")
+ #:listbox-item->text identity
+ #:button-text (G_ "Cancel")
+ #:button-callback-procedure button-callback))
+
+(define (run-type-page partition)
+ "Run a page asking the user to select a partition type."
+ (let* ((disk (partition-disk partition))
+ (partitions (disk-partitions disk))
+ (other-extended-partitions?
+ (any extended-partition? partitions))
+ (items
+ `(normal ,@(if other-extended-partitions?
+ '()
+ '(extended)))))
+ (run-listbox-selection-page
+ #:info-text (G_ "Please select a partition type")
+ #:title (G_ "Partition type")
+ #:listbox-items items
+ #:listbox-item->text symbol->string
+ #:sort-listbox-items? #f
+ #:button-text (G_ "Cancel")
+ #:button-callback-procedure button-cancel-action)))
+
+(define (run-fs-type-page)
+ "Run a page asking the user to select a file-system type."
+ (run-listbox-selection-page
+ #:info-text (G_ "Please select the file-system type for this partition")
+ #:title (G_ "File-system type")
+ #:listbox-items '(ext4 btrfs fat32 swap)
+ #:listbox-item->text user-fs-type-name
+ #:sort-listbox-items? #f
+ #:button-text (G_ "Cancel")
+ #:button-callback-procedure button-cancel-action))
+
+(define (inform-can-create-partition? user-partition)
+ "Return #t if it is possible to create USER-PARTITION. This is determined by
+calling CAN-CREATE-PARTITION? procedure. If an exception is raised, catch it
+an inform the user with an appropriate error-page and return #f."
+ (guard (c ((max-primary-exceeded? c)
+ (run-error-page
+ (G_ "Primary partitions count exceeded")
+ (G_ "Creation error"))
+ #f)
+ ((extended-creation-error? c)
+ (run-error-page
+ (G_ "Extended partition creation error")
+ (G_ "Creation error"))
+ #f)
+ ((logical-creation-error? c)
+ (run-error-page
+ (G_ "Logical partition creation error")
+ (G_ "Creation error"))
+ #f))
+ (can-create-partition? user-partition)))
+
+(define* (run-partition-page target-user-partition
+ #:key
+ (default-item #f))
+ "Run a page allowing the user to edit the given TARGET-USER-PARTITION
+record. If the argument DEFAULT-ITEM is passed, use it to select the current
+listbox item. This is used to avoid the focus to switch back to the first
+listbox entry while calling this procedure recursively."
+
+ (define (numeric-size device size)
+ "Parse the given SIZE on DEVICE and return it."
+ (call-with-values
+ (lambda ()
+ (unit-parse size device))
+ (lambda (value range)
+ value)))
+
+ (define (numeric-size-range device size)
+ "Parse the given SIZE on DEVICE and return the associated RANGE."
+ (call-with-values
+ (lambda ()
+ (unit-parse size device))
+ (lambda (value range)
+ range)))
+
+ (define* (fill-user-partition-geom user-part
+ #:key
+ device (size #f) start end)
+ "Return the given USER-PART with the START, END and SIZE fields set to the
+eponym arguments. Use UNIT-FORMAT-CUSTOM to format START and END arguments as
+sectors on DEVICE."
+ (user-partition
+ (inherit user-part)
+ (size size)
+ (start (unit-format-custom device start UNIT-SECTOR))
+ (end (unit-format-custom device end UNIT-SECTOR))))
+
+ (define (apply-user-partition-changes user-part)
+ "Set the name, file-system type and boot flag on the partition specified
+by USER-PART, if it is applicable for the partition type."
+ (let* ((partition (user-partition-parted-object user-part))
+ (disk (partition-disk partition))
+ (disk-type (disk-disk-type disk))
+ (device (disk-device disk))
+ (has-name? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-PARTITION-NAME))
+ (name (user-partition-name user-part))
+ (fs-type (filesystem-type-get
+ (user-fs-type-name
+ (user-partition-fs-type user-part))))
+ (bootable? (user-partition-bootable? user-part))
+ (esp? (user-partition-esp? user-part))
+ (flag-bootable?
+ (partition-is-flag-available? partition PARTITION-FLAG-BOOT))
+ (flag-esp?
+ (partition-is-flag-available? partition PARTITION-FLAG-ESP)))
+ (when (and has-name? name)
+ (partition-set-name partition name))
+ (partition-set-system partition fs-type)
+ (when flag-bootable?
+ (partition-set-flag partition
+ PARTITION-FLAG-BOOT
+ (if bootable? 1 0)))
+ (when flag-esp?
+ (partition-set-flag partition
+ PARTITION-FLAG-ESP
+ (if esp? 1 0)))
+ #t))
+
+ (define (listbox-action listbox-item)
+ (let* ((item (car listbox-item))
+ (partition (user-partition-parted-object
+ target-user-partition))
+ (disk (partition-disk partition))
+ (device (disk-device disk)))
+ (list
+ item
+ (case item
+ ((name)
+ (let* ((old-name (user-partition-name target-user-partition))
+ (name
+ (run-input-page (G_ "Please enter the partition gpt name.")
+ (G_ "Partition name")
+ #:default-text old-name)))
+ (user-partition
+ (inherit target-user-partition)
+ (name name))))
+ ((type)
+ (let ((new-type (run-type-page partition)))
+ (user-partition
+ (inherit target-user-partition)
+ (type new-type))))
+ ((bootable)
+ (user-partition
+ (inherit target-user-partition)
+ (bootable? (not (user-partition-bootable?
+ target-user-partition)))))
+ ((esp?)
+ (let ((new-esp? (not (user-partition-esp?
+ target-user-partition))))
+ (user-partition
+ (inherit target-user-partition)
+ (esp? new-esp?)
+ (mount-point (if new-esp?
+ (default-esp-mount-point)
+ "")))))
+ ((need-formating?)
+ (user-partition
+ (inherit target-user-partition)
+ (need-formating?
+ (not (user-partition-need-formating?
+ target-user-partition)))))
+ ((size)
+ (let* ((old-size (user-partition-size target-user-partition))
+ (max-size-value (partition-length partition))
+ (max-size (unit-format device max-size-value))
+ (start (partition-start partition))
+ (size (run-input-page
+ (format #f (G_ "Please enter the size of the
partition.\
+ The maximum size is ~a.") max-size)
+ (G_ "Partition size")
+ #:default-text (or old-size max-size)))
+ (size-percentage (read-percentage size))
+ (size-value (if size-percentage
+ (nearest-exact-integer
+ (/ (* max-size-value size-percentage)
+ 100))
+ (numeric-size device size)))
+ (end (and size-value
+ (+ start size-value)))
+ (size-range (numeric-size-range device size))
+ (size-range-ok? (and size-range
+ (< (+ start
+ (geometry-start size-range))
+ (partition-end partition)))))
+ (cond
+ ((and size-percentage (> size-percentage 100))
+ (run-error-page
+ (G_ "The percentage can not be superior to 100.")
+ (G_ "Size error"))
+ target-user-partition)
+ ((not size-value)
+ (run-error-page
+ (G_ "The requested size is incorrectly formatted, or too
large.")
+ (G_ "Size error"))
+ target-user-partition)
+ ((not (or size-percentage size-range-ok?))
+ (run-error-page
+ (G_ "The request size is superior to the maximum size.")
+ (G_ "Size error"))
+ target-user-partition)
+ (else
+ (fill-user-partition-geom target-user-partition
+ #:device device
+ #:size size
+ #:start start
+ #:end end)))))
+ ((fs-type)
+ (let ((fs-type (run-fs-type-page)))
+ (user-partition
+ (inherit target-user-partition)
+ (fs-type fs-type))))
+ ((mount-point)
+ (let* ((old-mount (or (user-partition-mount-point
+ target-user-partition)
+ ""))
+ (mount
+ (run-input-page
+ (G_ "Please enter the desired mounting point for this \
+partition. Leave this field empty if you don't want to set a mounting point.")
+ (G_ "Mounting point")
+ #:default-text old-mount
+ #:allow-empty-input? #t)))
+ (user-partition
+ (inherit target-user-partition)
+ (mount-point (and (not (string=? mount ""))
+ mount)))))))))
+
+ (define (button-action)
+ (let* ((partition (user-partition-parted-object
+ target-user-partition))
+ (prev-part (partition-prev partition))
+ (disk (partition-disk partition))
+ (device (disk-device disk))
+ (creation? (freespace-partition? partition))
+ (start (partition-start partition))
+ (end (partition-end partition))
+ (new-user-partition
+ (if (user-partition-start target-user-partition)
+ target-user-partition
+ (fill-user-partition-geom target-user-partition
+ #:device device
+ #:start start
+ #:end end))))
+ ;; It the backend PARTITION has free-space type, it means we are
+ ;; creating a new partition, otherwise, we are editing an already
+ ;; existing PARTITION.
+ (if creation?
+ (let* ((ok-create-partition?
+ (inform-can-create-partition? new-user-partition))
+ (new-partition
+ (and ok-create-partition?
+ (mkpart disk
+ new-user-partition
+ #:previous-partition prev-part))))
+ (and new-partition
+ (user-partition
+ (inherit new-user-partition)
+ (need-formating? #t)
+ (path (partition-get-path new-partition))
+ (disk-path (device-path device))
+ (parted-object new-partition))))
+ (and (apply-user-partition-changes new-user-partition)
+ new-user-partition))))
+
+ (let* ((items (user-partition-description target-user-partition))
+ (partition (user-partition-parted-object
+ target-user-partition))
+ (disk (partition-disk partition))
+ (device (disk-device disk))
+ (path (device-path device))
+ (number-str (partition-print-number partition))
+ (type (user-partition-type target-user-partition))
+ (type-str (symbol->string type))
+ (start (unit-format device (partition-start partition)))
+ (creation? (freespace-partition? partition))
+ (default-item (and default-item
+ (find (lambda (item)
+ (eq? (car item) default-item))
+ items)))
+ (result
+ (run-listbox-selection-page
+ #:info-text
+ (if creation?
+ (G_ (format #f "Creating ~a partition starting at ~a of ~a."
+ type-str start path))
+ (G_ (format #f "You are currently editing partition ~a."
+ number-str)))
+ #:title (if creation?
+ (G_ "Partition creation")
+ (G_ "Partition edit"))
+ #:listbox-items items
+ #:listbox-item->text cdr
+ #:sort-listbox-items? #f
+ #:listbox-default-item default-item
+ #:button-text (G_ "Ok")
+ #:listbox-callback-procedure listbox-action
+ #:button-callback-procedure button-action)))
+ (match result
+ ((item new-user-partition)
+ (run-partition-page new-user-partition
+ #:default-item item))
+ (else result))))
+
+(define* (run-disk-page disks
+ #:optional (user-partitions '()))
+ "Run a page allowing to edit the partition tables of the given DISKS. If
+specified, USER-PARTITIONS is a list of <user-partition> records associated to
+the partitions on DISKS."
+
+ (define (other-logical-partitions? partitions)
+ "Return #t if at least one of the partition in PARTITIONS list is a
+logical partition, return #f otherwise."
+ (any logical-partition? partitions))
+
+ (define (other-non-logical-partitions? partitions)
+ "Return #t is at least one of the partitions in PARTITIONS list is not a
+logical partition, return #f otherwise."
+ (let ((non-logical-partitions
+ (remove logical-partition? partitions)))
+ (or (any normal-partition? non-logical-partitions)
+ (any freespace-partition? non-logical-partitions))))
+
+ (define (add-tree-symbols partitions descriptions)
+ "Concatenate tree symbols to the given DESCRIPTIONS list and return
+it. The PARTITIONS list is the list of partitions described in
+DESCRIPTIONS. The tree symbols are used to indicate the partition's disk and
+for logical partitions, the extended partition which includes them."
+ (match descriptions
+ (() '())
+ ((description . rest-descriptions)
+ (match partitions
+ ((partition . rest-partitions)
+ (if (null? rest-descriptions)
+ (list (if (logical-partition? partition)
+ (string-append " ┗━ " description)
+ (string-append "┗━ " description)))
+ (cons (cond
+ ((extended-partition? partition)
+ (if (other-non-logical-partitions? rest-partitions)
+ (string-append "┣┳ " description)
+ (string-append "┗┳ " description)))
+ ((logical-partition? partition)
+ (if (other-logical-partitions? rest-partitions)
+ (if (other-non-logical-partitions? rest-partitions)
+ (string-append "┃┣━ " description)
+ (string-append " ┣━ " description))
+ (if (other-non-logical-partitions? rest-partitions)
+ (string-append "┃┗━ " description)
+ (string-append " ┗━ " description))))
+ (else
+ (string-append "┣━ " description)))
+ (add-tree-symbols rest-partitions
+ rest-descriptions))))))))
+
+ (define (skip-item? item)
+ (eq? (car item) 'skip))
+
+ (define (disk-items)
+ "Return the list of strings describing DISKS."
+ (let loop ((disks disks))
+ (match disks
+ (() '())
+ ((disk . rest)
+ (let* ((device (disk-device disk))
+ (partitions (disk-partitions disk))
+ (partitions*
+ (filter-map
+ (lambda (partition)
+ (and (not (metadata-partition? partition))
+ (not (small-freespace-partition? device
+ partition))
+ partition))
+ partitions))
+ (descriptions (add-tree-symbols
+ partitions*
+ (partitions-descriptions partitions*
+ user-partitions)))
+ (partition-items (map cons partitions* descriptions)))
+ (append
+ `((,disk . ,(device-description device disk))
+ ,@partition-items
+ ,@(if (null? rest)
+ '()
+ '((skip . ""))))
+ (loop rest)))))))
+
+ (define (remove-user-partition-by-partition user-partitions partition)
+ "Return the USER-PARTITIONS list with the record with the given PARTITION
+object removed. If PARTITION is an extended partition, also remove all logical
+partitions from USER-PARTITIONS."
+ (remove (lambda (p)
+ (let ((cur-partition (user-partition-parted-object p)))
+ (or (equal? cur-partition partition)
+ (and (extended-partition? partition)
+ (logical-partition? cur-partition)))))
+ user-partitions))
+
+ (define (remove-user-partition-by-disk user-partitions disk)
+ "Return the USER-PARTITIONS list with the <user-partition> records located
+on given DISK removed."
+ (remove (lambda (p)
+ (let* ((partition (user-partition-parted-object p))
+ (cur-disk (partition-disk partition)))
+ (equal? cur-disk disk)))
+ user-partitions))
+
+ (define (update-user-partitions user-partitions new-user-partition)
+ "Update or insert NEW-USER-PARTITION record in USER-PARTITIONS list
+depending if one of the <user-partition> record in USER-PARTITIONS has the
+same PARTITION object as NEW-USER-PARTITION."
+ (let* ((partition (user-partition-parted-object new-user-partition))
+ (user-partitions*
+ (remove-user-partition-by-partition user-partitions
+ partition)))
+ (cons new-user-partition user-partitions*)))
+
+ (define (button-ok-action)
+ "Commit the modifications to all DISKS and return #t."
+ (for-each (lambda (disk)
+ (disk-commit disk))
+ disks)
+ #t)
+
+ (define (listbox-action listbox-item)
+ "A disk or a partition has been selected. If it's a disk, ask for a label
+to create a new partition table. If it is a partition, propose the user to
+edit it."
+ (let ((item (car listbox-item)))
+ (cond
+ ((disk? item)
+ (let ((label (run-label-page (const #f))))
+ (if label
+ (let* ((device (disk-device item))
+ (new-disk (mklabel device label))
+ (commit-new-disk (disk-commit new-disk))
+ (other-disks (remove (lambda (disk)
+ (equal? disk item))
+ disks))
+ (new-user-partitions
+ (remove-user-partition-by-disk user-partitions item)))
+ (disk-destroy item)
+ `((disks . ,(cons new-disk other-disks))
+ (user-partitions . ,new-user-partitions)))
+ `((disks . ,disks)
+ (user-partitions . ,user-partitions)))))
+ ((partition? item)
+ (let* ((partition item)
+ (disk (partition-disk partition))
+ (device (disk-device disk))
+ (existing-user-partition
+ (find-user-partition-by-parted-object user-partitions
+ partition))
+ (edit-user-partition
+ (or existing-user-partition
+ (partition->user-partition partition))))
+ `((disks . ,disks)
+ (user-partitions . ,user-partitions)
+ (edit-user-partition . ,edit-user-partition)))))))
+
+ (define (hotkey-action key listbox-item)
+ "The DELETE key has been pressed on a disk or a partition item."
+ (let ((item (car listbox-item))
+ (default-result
+ `((disks . ,disks)
+ (user-partitions . ,user-partitions))))
+ (cond
+ ((disk? item)
+ (let* ((device (disk-device item))
+ (path (device-path device))
+ (info-text
+ (format #f (G_ "Are you sure you want to delete everything on
disk ~a?")
+ path))
+ (result (choice-window (G_ "Delete disk")
+ (G_ "Ok")
+ (G_ "Cancel")
+ info-text)))
+ (case result
+ ((1)
+ (disk-delete-all item)
+ `((disks . ,disks)
+ (user-partitions
+ . ,(remove-user-partition-by-disk user-partitions item))))
+ (else
+ default-result))))
+ ((partition? item)
+ (if (freespace-partition? item)
+ (run-error-page (G_ "You cannot delete a free space area.")
+ (G_ "Delete partition"))
+ (let* ((disk (partition-disk item))
+ (number-str (partition-print-number item))
+ (info-text
+ (format #f (G_ "Are you sure you want to delete partition
~a?")
+ number-str))
+ (result (choice-window (G_ "Delete partition")
+ (G_ "Ok")
+ (G_ "Cancel")
+ info-text)))
+ (case result
+ ((1)
+ (let ((new-user-partitions
+ (remove-user-partition-by-partition user-partitions
+ item)))
+ (disk-delete-partition disk item)
+ `((disks . ,disks)
+ (user-partitions . ,new-user-partitions))))
+ (else
+ default-result))))))))
+
+ (let ((result
+ (run-listbox-selection-page
+
+ #:info-text (G_ "You can change a disk's partition table by \
+selecting it and pressing ENTER. You can also edit a partition by selecting it
\
+and pressing ENTER, or remove it by pressing DELETE. To create a new \
+partition, select a free space area and press ENTER.
+
+At least one partition must have its mounting point set to '/'.")
+
+ #:title (G_ "Manual partitioning")
+ #:info-textbox-width 70
+ #:listbox-items (disk-items)
+ #:listbox-item->text cdr
+ #:sort-listbox-items? #f
+ #:skip-item-procedure? skip-item?
+ #:allow-delete? #t
+ #:button-text (G_ "Ok")
+ #:button-callback-procedure button-ok-action
+ #:button2-text (G_ "Cancel")
+ #:button2-callback-procedure button-cancel-action
+ #:listbox-callback-procedure listbox-action
+ #:hotkey-callback-procedure hotkey-action)))
+ (if (eq? result #t)
+ (let ((user-partitions-ok?
+ (guard
+ (c ((no-root-mount-point? c)
+ (run-error-page
+ (G_ "No root mount point found")
+ (G_ "Missing mount point"))
+ #f))
+ (check-user-partitions user-partitions))))
+ (if user-partitions-ok?
+ (begin
+ (for-each (cut disk-destroy <>) disks)
+ user-partitions)
+ (run-disk-page disks user-partitions)))
+ (let* ((result-disks (assoc-ref result 'disks))
+ (result-user-partitions (assoc-ref result
+ 'user-partitions))
+ (edit-user-partition (assoc-ref result
+ 'edit-user-partition))
+ (can-create-partition?
+ (and edit-user-partition
+ (inform-can-create-partition? edit-user-partition)))
+ (new-user-partition (and edit-user-partition
+ can-create-partition?
+ (run-partition-page
+ edit-user-partition)))
+ (new-user-partitions
+ (if new-user-partition
+ (update-user-partitions result-user-partitions
+ new-user-partition)
+ result-user-partitions)))
+ (run-disk-page result-disks new-user-partitions)))))
+
+(define (run-partioning-page)
+ "Run a page asking the user for a partitioning method."
+ (define (run-page devices)
+ (let* ((items
+ '((entire . "Guided - using the entire disk")
+ (manual . "Manual")))
+ (result (run-listbox-selection-page
+ #:info-text (G_ "Please select a partitioning method.")
+ #:title (G_ "Partitioning method")
+ #:listbox-items items
+ #:listbox-item->text cdr
+ #:button-text (G_ "Cancel")
+ #:button-callback-procedure button-cancel-action))
+ (method (car result)))
+ (case method
+ ((entire)
+ (let* ((device (run-device-page devices))
+ (disk-type (disk-probe device))
+ (disk (if disk-type
+ (disk-new device)
+ (let* ((label (run-label-page
+ button-cancel-action))
+ (disk (mklabel device label)))
+ (disk-commit disk)
+ disk)))
+ (scheme (symbol-append method '- (run-scheme-page)))
+ (user-partitions (append
+ (auto-partition disk #:scheme scheme)
+ (create-special-user-partitions
+ (disk-partitions disk)))))
+ (run-disk-page (list disk) user-partitions)))
+ ((manual)
+ (let* ((disks (map disk-new devices))
+ (user-partitions (append-map
+ create-special-user-partitions
+ (map disk-partitions disks)))
+ (result-user-partitions (run-disk-page disks
+ user-partitions)))
+ result-user-partitions)))))
+
+ (init-parted)
+ (let* ((non-install-devices (non-install-devices))
+ (user-partitions (run-page non-install-devices))
+ (form (draw-formating-page)))
+ ;; Make sure the disks are not in use before proceeding to formating.
+ (free-parted non-install-devices)
+ (run-error-page (format #f "~a" user-partitions)
+ "user-partitions")
+ (format-user-partitions user-partitions)
+ (destroy-form-and-pop form)
+ user-partitions))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
new file mode 100644
index 0000000..3fe9381
--- /dev/null
+++ b/gnu/installer/parted.scm
@@ -0,0 +1,1210 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <address@hidden>
+;;;
+;;; 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/>.
+
+(define-module (gnu installer parted)
+ #:use-module (gnu installer steps)
+ #:use-module (gnu installer utils)
+ #:use-module (gnu installer newt page)
+ #:use-module (gnu system uuid)
+ #:use-module ((gnu build file-systems)
+ #:select (read-partition-uuid))
+ #:use-module (guix build syscalls)
+ #:use-module (guix build utils)
+ #:use-module (guix records)
+ #:use-module (guix i18n)
+ #:use-module (parted)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:export (<user-partition>
+ user-partition
+ make-user-partition
+ user-partition?
+ user-partition-name
+ user-partition-type
+ user-partition-path
+ user-partition-disk-path
+ user-partition-fs-type
+ user-partition-bootable?
+ user-partition-esp?
+ user-partition-bios-grub?
+ user-partition-size
+ user-partition-start
+ user-partition-end
+ user-partition-mount-point
+ user-partition-need-formating?
+ user-partition-parted-object
+
+ find-esp-partition
+ data-partition?
+ metadata-partition?
+ freespace-partition?
+ small-freespace-partition?
+ normal-partition?
+ extended-partition?
+ logical-partition?
+ esp-partition?
+ boot-partition?
+ default-esp-mount-point
+
+ with-delay-device-in-use?
+ force-device-sync
+ non-install-devices
+ partition-user-type
+ user-fs-type-name
+ partition-filesystem-user-type
+ partition-get-flags
+ partition->user-partition
+ create-special-user-partitions
+ find-user-partition-by-parted-object
+
+ device-description
+ partition-end-formatted
+ partition-print-number
+ partition-description
+ partitions-descriptions
+ user-partition-description
+
+ &max-primary-exceeded
+ max-primary-exceeded?
+ &extended-creation-error
+ extended-creation-error?
+ &logical-creation-error
+ logical-creation-error?
+
+ can-create-partition?
+ mklabel
+ mkpart
+ rmpart
+
+ create-adjacent-partitions
+ auto-partition
+
+ &no-root-mount-point
+ no-root-mount-point?
+
+ check-user-partitions
+ set-user-partitions-path
+ format-user-partitions
+ mount-user-partitions
+ umount-user-partitions
+ with-mounted-partitions
+ user-partitions->file-systems
+ user-partitions->configuration
+
+ init-parted
+ free-parted))
+
+
+;;;
+;;; Partition record.
+;;;
+
+(define-record-type* <user-partition>
+ user-partition make-user-partition
+ user-partition?
+ (name user-partition-name ;string
+ (default #f))
+ (type user-partition-type
+ (default 'normal)) ; 'normal | 'logical | 'extended
+ (path user-partition-path
+ (default #f))
+ (disk-path user-partition-disk-path
+ (default #f))
+ (fs-type user-partition-fs-type
+ (default 'ext4))
+ (bootable? user-partition-bootable?
+ (default #f))
+ (esp? user-partition-esp?
+ (default #f))
+ (bios-grub? user-partition-bios-grub?
+ (default #f))
+ (size user-partition-size
+ (default #f))
+ (start user-partition-start ;start as string (e.g. '11MB')
+ (default #f))
+ (end user-partition-end ;same as start
+ (default #f))
+ (mount-point user-partition-mount-point ;string
+ (default #f))
+ (need-formating? user-partition-need-formating? ; boolean
+ (default #f))
+ (parted-object user-partition-parted-object ; <partition> from parted
+ (default #f)))
+
+
+;;
+;; Utilities.
+;;
+
+(define (find-esp-partition partitions)
+ "Find and return the ESP partition among PARTITIONS."
+ (find esp-partition? partitions))
+
+(define (data-partition? partition)
+ "Return #t if PARTITION is a partition dedicated to data (by opposition to
+freespace, metadata and protected partition types), return #f otherwise."
+ (let ((type (partition-type partition)))
+ (not (any (lambda (flag)
+ (member flag type))
+ '(free-space metadata protected)))))
+
+(define (metadata-partition? partition)
+ "Return #t if PARTITION is a metadata partition, #f otherwise."
+ (let ((type (partition-type partition)))
+ (member 'metadata type)))
+
+(define (freespace-partition? partition)
+ "Return #t if PARTITION is a free-space partition, #f otherwise."
+ (let ((type (partition-type partition)))
+ (member 'free-space type)))
+
+(define* (small-freespace-partition? device
+ partition
+ #:key (max-size MEBIBYTE-SIZE))
+ "Return #t is PARTITION is a free-space partition with less a size strictly
+inferior to MAX-SIZE, #f otherwise."
+ (let ((size (partition-length partition))
+ (max-sector-size (/ max-size
+ (device-sector-size device))))
+ (< size max-sector-size)))
+
+(define (normal-partition? partition)
+ "return #t if partition is a normal partition, #f otherwise."
+ (let ((type (partition-type partition)))
+ (member 'normal type)))
+
+(define (extended-partition? partition)
+ "return #t if partition is an extended partition, #f otherwise."
+ (let ((type (partition-type partition)))
+ (member 'extended type)))
+
+(define (logical-partition? partition)
+ "Return #t if PARTITION is a logical partition, #f otherwise."
+ (let ((type (partition-type partition)))
+ (member 'logical type)))
+
+(define (partition-user-type partition)
+ "Return the type of PARTITION, to be stored in the TYPE field of
+<user-partition> record. It can be 'normal, 'extended or 'logical."
+ (cond ((normal-partition? partition)
+ 'normal)
+ ((extended-partition? partition)
+ 'extended)
+ ((logical-partition? partition)
+ 'logical)
+ (else #f)))
+
+(define (esp-partition? partition)
+ "Return #t if partition has the ESP flag, return #f otherwise."
+ (let* ((disk (partition-disk partition))
+ (disk-type (disk-disk-type disk))
+ (has-extended? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-EXTENDED)))
+ (and (data-partition? partition)
+ (not has-extended?)
+ (partition-is-flag-available? partition PARTITION-FLAG-ESP)
+ (partition-get-flag partition PARTITION-FLAG-ESP))))
+
+(define (boot-partition? partition)
+ "Return #t if partition has the boot flag, return #f otherwise."
+ (and (data-partition? partition)
+ (partition-is-flag-available? partition PARTITION-FLAG-BOOT)
+ (partition-get-flag partition PARTITION-FLAG-BOOT)))
+
+
+;; The default mount point for ESP partitions.
+(define default-esp-mount-point
+ (make-parameter "/boot/efi"))
+
+(define (efi-installation?)
+ "Return #t if an EFI installation should be performed, #f otherwise."
+ (file-exists? "/sys/firmware/efi"))
+
+(define (user-fs-type-name fs-type)
+ "Return the name of FS-TYPE as specified by libparted."
+ (case fs-type
+ ((ext4) "ext4")
+ ((btrfs) "btrfs")
+ ((fat32) "fat32")
+ ((swap) "linux-swap")))
+
+(define (user-fs-type->mount-type fs-type)
+ "Return the mount type of FS-TYPE."
+ (case fs-type
+ ((ext4) "ext4")
+ ((btrfs) "btrfs")
+ ((fat32) "vfat")))
+
+(define (partition-filesystem-user-type partition)
+ "Return the filesystem type of PARTITION, to be stored in the FS-TYPE field
+of <user-partition> record."
+ (let ((fs-type (partition-fs-type partition)))
+ (and fs-type
+ (let ((name (filesystem-type-name fs-type)))
+ (cond
+ ((string=? name "ext4") 'ext4)
+ ((string=? name "btrfs") 'btrfs)
+ ((string=? name "fat32") 'fat32)
+ ((or (string=? name "swsusp")
+ (string=? name "linux-swap(v0)")
+ (string=? name "linux-swap(v1)"))
+ 'swap)
+ (else
+ (error (format #f "Unhandled ~a fs-type~%" name))))))))
+
+(define (partition-get-flags partition)
+ "Return the list of flags supported by the given PARTITION."
+ (filter-map (lambda (flag)
+ (and (partition-get-flag partition flag)
+ flag))
+ (partition-flags partition)))
+
+(define (partition->user-partition partition)
+ "Convert PARTITION into a <user-partition> record and return it."
+ (let* ((disk (partition-disk partition))
+ (device (disk-device disk))
+ (disk-type (disk-disk-type disk))
+ (has-name? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-PARTITION-NAME))
+ (name (and has-name?
+ (data-partition? partition)
+ (partition-get-name partition))))
+ (user-partition
+ (name (and (and name
+ (not (string=? name "")))
+ name))
+ (type (or (partition-user-type partition)
+ 'normal))
+ (path (partition-get-path partition))
+ (disk-path (device-path device))
+ (fs-type (or (partition-filesystem-user-type partition)
+ 'ext4))
+ (mount-point (and (esp-partition? partition)
+ (default-esp-mount-point)))
+ (bootable? (boot-partition? partition))
+ (esp? (esp-partition? partition))
+ (parted-object partition))))
+
+(define (create-special-user-partitions partitions)
+ "Return a list with a <user-partition> record describing the ESP partition
+found in PARTITIONS, if any."
+ (filter-map (lambda (partition)
+ (and (esp-partition? partition)
+ (partition->user-partition partition)))
+ partitions))
+
+(define (find-user-partition-by-parted-object user-partitions
+ partition)
+ "Find and return the <user-partition> record in USER-PARTITIONS list which
+PARTED-OBJECT field equals PARTITION, return #f if not found."
+ (find (lambda (user-partition)
+ (equal? (user-partition-parted-object user-partition)
+ partition))
+ user-partitions))
+
+
+;;
+;; Devices
+;;
+
+(define (with-delay-device-in-use? path)
+ "Call DEVICE-IN-USE? with a few retries, as the first re-read will often
+fail. See rereadpt function in wipefs.c of util-linux for an explanation."
+ (let loop ((try 4))
+ (usleep 250000)
+ (let ((in-use? (device-in-use? path)))
+ (if (and in-use? (> try 0))
+ (loop (- try 1))
+ in-use?))))
+
+(define* (force-device-sync device)
+ "Force a flushing of the given DEVICE."
+ (device-open device)
+ (device-sync device)
+ (device-close device))
+
+(define (non-install-devices)
+ "Return all the available devices, except the busy one, allegedly the
+install device. DEVICE-IS-BUSY? is a parted call, checking if the device is
+mounted. The install image uses an overlayfs so the install device does not
+appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE?
+from (guix build syscalls) module, who will try to re-read the device's
+partition table to determine whether or not it is already used (like sfdisk
+from util-linux)."
+ (remove (lambda (device)
+ (let ((path (device-path device)))
+ (or (device-is-busy? device)
+ (with-delay-device-in-use? path))))
+ (devices)))
+
+
+;;
+;; Disk and partition printing.
+;;
+
+(define* (device-description device #:optional disk)
+ "Return a string describing the given DEVICE."
+ (let* ((type (device-type device))
+ (path (device-path device))
+ (model (device-model device))
+ (type-str (device-type->string type))
+ (disk-type (if disk
+ (disk-disk-type disk)
+ (disk-probe device)))
+ (length (device-length device))
+ (sector-size (device-sector-size device))
+ (end (unit-format-custom-byte device
+ (* length sector-size)
+ UNIT-GIGABYTE)))
+ (string-join
+ `(,@(if (string=? model "")
+ `(,type-str)
+ `(,model ,(string-append "(" type-str ")")))
+ ,path
+ ,end
+ ,@(if disk-type
+ `(,(disk-type-name disk-type))
+ '()))
+ " ")))
+
+(define (partition-end-formatted device partition)
+ "Return as a string the end of PARTITION with the relevant unit."
+ (unit-format-byte
+ device
+ (-
+ (* (+ (partition-end partition) 1)
+ (device-sector-size device))
+ 1)))
+
+(define (partition-print-number partition)
+ "Convert the given partition NUMBER to string."
+ (let ((number (partition-number partition)))
+ (number->string number)))
+
+(define (partition-description partition user-partition)
+ "Return a string describing the given PARTITION, located on the DISK of
+DEVICE."
+
+ (define (partition-print-type partition)
+ "Return the type of PARTITION as a string."
+ (if (freespace-partition? partition)
+ (G_ "Free space")
+ (let ((type (partition-type partition)))
+ (match type
+ ((type-symbol)
+ (symbol->string type-symbol))))))
+
+ (define (partition-print-flags partition)
+ "Return the flags of PARTITION as a string of comma separated flags."
+ (string-join
+ (filter-map
+ (lambda (flag)
+ (and (partition-get-flag partition flag)
+ (partition-flag-get-name flag)))
+ (partition-flags partition))
+ ","))
+
+ (define (maybe-string-pad string length)
+ "Returned a string formatted by padding STRING of LENGTH characters to the
+right. If STRING is #f use an empty string."
+ (string-pad-right (or string "") length))
+
+ (let* ((disk (partition-disk partition))
+ (device (disk-device disk))
+ (disk-type (disk-disk-type disk))
+ (has-name? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-PARTITION-NAME))
+ (has-extended? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-EXTENDED))
+ (part-type (partition-print-type partition))
+ (number (and (not (freespace-partition? partition))
+ (partition-print-number partition)))
+ (name (and has-name?
+ (if (freespace-partition? partition)
+ (G_ "Free space")
+ (partition-get-name partition))))
+ (start (unit-format device
+ (partition-start partition)))
+ (end (partition-end-formatted device partition))
+ (size (unit-format device (partition-length partition)))
+ (fs-type (partition-fs-type partition))
+ (fs-type-name (and fs-type
+ (filesystem-type-name fs-type)))
+ (flags (and (not (freespace-partition? partition))
+ (partition-print-flags partition)))
+ (mount-point (and user-partition
+ (user-partition-mount-point user-partition))))
+ `(,(or number "")
+ ,@(if has-extended?
+ (list part-type)
+ '())
+ ,size
+ ,(or fs-type-name "")
+ ,(or flags "")
+ ,(or mount-point "")
+ ,(maybe-string-pad name 30))))
+
+(define (partitions-descriptions partitions user-partitions)
+ "Return a list of strings describing all the partitions found on
+DEVICE. METADATA partitions are not described. The strings are padded to the
+right so that they can be displayed as a table."
+
+ (define (max-length-column lists column-index)
+ "Return the maximum length of the string at position COLUMN-INDEX in the
+list of string lists LISTS."
+ (apply max
+ (map (lambda (list)
+ (string-length
+ (list-ref list column-index)))
+ lists)))
+
+ (define (pad-descriptions descriptions)
+ "Return a padded version of the list of string lists DESCRIPTIONS. The
+strings are padded to the length of the longer string in a same column, as
+determined by MAX-LENGTH-COLUMN procedure."
+ (let* ((description-length (length (car descriptions)))
+ (paddings (map (lambda (index)
+ (max-length-column descriptions index))
+ (iota description-length))))
+ (map (lambda (description)
+ (map string-pad-right description paddings))
+ descriptions)))
+
+ (let* ((descriptions
+ (map
+ (lambda (partition)
+ (let ((user-partition
+ (find-user-partition-by-parted-object user-partitions
+ partition)))
+ (partition-description partition user-partition)))
+ partitions))
+ (padded-descriptions (if (null? partitions)
+ '()
+ (pad-descriptions descriptions))))
+ (map (cut string-join <> " ") padded-descriptions)))
+
+(define (user-partition-description user-partition)
+ "Return a string describing the given USER-PARTITION record."
+ (let* ((partition (user-partition-parted-object user-partition))
+ (disk (partition-disk partition))
+ (disk-type (disk-disk-type disk))
+ (device (disk-device disk))
+ (has-name? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-PARTITION-NAME))
+ (has-extended? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-EXTENDED))
+ (name (user-partition-name user-partition))
+ (type (user-partition-type user-partition))
+ (type-name (symbol->string type))
+ (fs-type (user-partition-fs-type user-partition))
+ (fs-type-name (user-fs-type-name fs-type))
+ (bootable? (user-partition-bootable? user-partition))
+ (esp? (user-partition-esp? user-partition))
+ (need-formating? (user-partition-need-formating? user-partition))
+ (size (user-partition-size user-partition))
+ (mount-point (user-partition-mount-point user-partition)))
+ `(,@(if has-name?
+ `((name . ,(string-append "Name: " (or name "None"))))
+ '())
+ ,@(if (and has-extended?
+ (freespace-partition? partition)
+ (not (eq? type 'logical)))
+ `((type . ,(string-append "Type: " type-name)))
+ '())
+ ,@(if (eq? type 'extended)
+ '()
+ `((fs-type . ,(string-append "Filesystem type: " fs-type-name))))
+ ,@(if (or (eq? type 'extended)
+ (eq? fs-type 'swap)
+ (not has-extended?))
+ '()
+ `((bootable . ,(string-append "Bootable flag: "
+ (if bootable? "On" "Off")))))
+ ,@(if (and (not has-extended?)
+ (not (eq? fs-type 'swap)))
+ `((esp? . ,(string-append "ESP flag: "
+ (if esp? "On" "Off"))))
+ '())
+ ,@(if (freespace-partition? partition)
+ (let ((size-formatted
+ (or size (unit-format device
+ (partition-length partition)))))
+ `((size . ,(string-append "Size : " size-formatted))))
+ '())
+ ,@(if (or (freespace-partition? partition)
+ (eq? fs-type 'swap))
+ '()
+ `((need-formating?
+ . ,(string-append "Format the partition? : "
+ (if need-formating? "Yes" "No")))))
+ ,@(if (or (eq? type 'extended)
+ (eq? fs-type 'swap))
+ '()
+ `((mount-point
+ . ,(string-append "Mount point : "
+ (or mount-point
+ (and esp? (default-esp-mount-point))
+ "None"))))))))
+
+
+;;
+;; Partition table creation.
+;;
+
+(define (mklabel device type-name)
+ "Create a partition table on DEVICE. TYPE-NAME is the type of the partition
+table, \"msdos\" or \"gpt\"."
+ (let ((type (disk-type-get type-name)))
+ (disk-new-fresh device type)))
+
+
+;;
+;; Partition creation.
+;;
+
+;; The maximum count of primary partitions is exceeded.
+(define-condition-type &max-primary-exceeded &condition
+ max-primary-exceeded?)
+
+;; It is not possible to create an extended partition.
+(define-condition-type &extended-creation-error &condition
+ extended-creation-error?)
+
+;; It is not possible to create a logical partition.
+(define-condition-type &logical-creation-error &condition
+ logical-creation-error?)
+
+(define (can-create-primary? disk)
+ "Return #t if it is possible to create a primary partition on DISK, return
+#f otherwise."
+ (let ((max-primary (disk-get-max-primary-partition-count disk)))
+ (find (lambda (number)
+ (not (disk-get-partition disk number)))
+ (iota max-primary 1))))
+
+(define (can-create-extended? disk)
+ "Return #t if it is possible to create an extended partition on DISK, return
+#f otherwise."
+ (let* ((disk-type (disk-disk-type disk))
+ (has-extended? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-EXTENDED)))
+ (and (can-create-primary? disk)
+ has-extended?
+ (not (disk-extended-partition disk)))))
+
+(define (can-create-logical? disk)
+ "Return #t is it is possible to create a logical partition on DISK, return
+#f otherwise."
+ (let* ((disk-type (disk-disk-type disk))
+ (has-extended? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-EXTENDED)))
+ (and has-extended?
+ (disk-extended-partition disk))))
+
+(define (can-create-partition? user-part)
+ "Return #t if it is possible to create the given USER-PART record, return #f
+otherwise."
+ (let* ((type (user-partition-type user-part))
+ (partition (user-partition-parted-object user-part))
+ (disk (partition-disk partition)))
+ (case type
+ ((normal)
+ (or (can-create-primary? disk)
+ (raise
+ (condition (&max-primary-exceeded)))))
+ ((extended)
+ (or (can-create-extended? disk)
+ (raise
+ (condition (&extended-creation-error)))))
+ ((logical)
+ (or (can-create-logical? disk)
+ (raise
+ (condition (&logical-creation-error))))))))
+
+(define* (mkpart disk user-partition
+ #:key (previous-partition #f))
+ "Create the given USER-PARTITION on DISK. The PREVIOUS-PARTITION argument as
+to be set to the partition preceeding USER-PARTITION if any."
+
+ (define (parse-start-end start end)
+ "Parse start and end strings as positions on DEVICE expressed with a unit,
+like '100GB' or '12.2KiB'. Return a list of 4 elements, the start sector, its
+range (1 unit large area centered on start sector), the end sector and its
+range."
+ (let ((device (disk-device disk)))
+ (call-with-values
+ (lambda ()
+ (unit-parse start device))
+ (lambda (start-sector start-range)
+ (call-with-values
+ (lambda ()
+ (unit-parse end device))
+ (lambda (end-sector end-range)
+ (list start-sector start-range
+ end-sector end-range)))))))
+
+ (define* (extend-ranges! start-range end-range
+ #:key (offset 0))
+ "Try to extend START-RANGE by 1 MEBIBYTE to the right and END-RANGE by 1
+MEBIBYTE to the left. This way, if the disk is aligned on 2048 sectors of
+512KB (like frequently), we will have a chance for the
+'optimal-align-constraint' to succeed. Do not extend ranges if that would
+cause them to cross."
+ (let* ((device (disk-device disk))
+ (start-range-end (geometry-end start-range))
+ (end-range-start (geometry-start end-range))
+ (mebibyte-sector-size (/ MEBIBYTE-SIZE
+ (device-sector-size device)))
+ (new-start-range-end
+ (+ start-range-end mebibyte-sector-size offset))
+ (new-end-range-start
+ (- end-range-start mebibyte-sector-size offset)))
+ (when (< new-start-range-end new-end-range-start)
+ (geometry-set-end start-range new-start-range-end)
+ (geometry-set-start end-range new-end-range-start))))
+
+ (match (parse-start-end (user-partition-start user-partition)
+ (user-partition-end user-partition))
+ ((start-sector start-range end-sector end-range)
+ (let* ((prev-end (if previous-partition
+ (partition-end previous-partition)
+ 0))
+ (start-distance (- start-sector prev-end))
+ (type (user-partition-type user-partition))
+ ;; There should be at least 2 unallocated sectors in front of each
+ ;; logical partition, otherwise parted will fail badly:
+ ;; https://gparted.org/h2-fix-msdos-pt.php#apply-action-fail.
+ (start-offset (if previous-partition
+ (- 3 start-distance)
+ 0))
+ (start-sector* (if (and (eq? type 'logical)
+ (< start-distance 3))
+ (+ start-sector start-offset)
+ start-sector)))
+ ;; This is a hackery but parted almost always fails to create optimally
+ ;; aligned partitions (unless specifiying percentages) because, the
+ ;; default range of 1MB centered on the start sector is not enough when
+ ;; the optimal alignment is 2048 sectors of 512KB.
+ (extend-ranges! start-range end-range #:offset start-offset)
+
+ (let* ((device (disk-device disk))
+ (disk-type (disk-disk-type disk))
+ (length (device-length device))
+ (name (user-partition-name user-partition))
+ (filesystem-type
+ (filesystem-type-get
+ (user-fs-type-name
+ (user-partition-fs-type user-partition))))
+ (flags `(,@(if (user-partition-bootable? user-partition)
+ `(,PARTITION-FLAG-BOOT)
+ '())
+ ,@(if (user-partition-esp? user-partition)
+ `(,PARTITION-FLAG-ESP)
+ '())
+ ,@(if (user-partition-bios-grub? user-partition)
+ `(,PARTITION-FLAG-BIOS-GRUB)
+ '())))
+ (has-name? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-PARTITION-NAME))
+ (partition-type (partition-type->int type))
+ (partition (partition-new disk
+ #:type partition-type
+ #:filesystem-type filesystem-type
+ #:start start-sector*
+ #:end end-sector))
+ (user-constraint (constraint-new
+ #:start-align 'any
+ #:end-align 'any
+ #:start-range start-range
+ #:end-range end-range
+ #:min-size 1
+ #:max-size length))
+ (dev-constraint
+ (device-get-optimal-aligned-constraint device))
+ (final-constraint (constraint-intersect user-constraint
+ dev-constraint))
+ (no-constraint (constraint-any device))
+ ;; Try to create a partition with an optimal alignment
+ ;; constraint. If it fails, fallback to creating a partition with
+ ;; no specific constraint.
+ (partition-ok?
+ (or (disk-add-partition disk partition final-constraint)
+ (disk-add-partition disk partition no-constraint))))
+ ;; Set the partition name if supported.
+ (when (and partition-ok? has-name? name)
+ (partition-set-name partition name))
+
+ ;; Set flags is required.
+ (for-each (lambda (flag)
+ (and (partition-is-flag-available? partition flag)
+ (partition-set-flag partition flag 1)))
+ flags)
+
+ (and partition-ok?
+ (partition-set-system partition filesystem-type)
+ partition))))))
+
+
+;;
+;; Partition destruction.
+;;
+
+(define (rmpart disk number)
+ "Remove the partition with the given NUMBER on DISK."
+ (let ((partition (disk-get-partition disk number)))
+ (disk-remove-partition disk partition)))
+
+
+;;
+;; Auto partitionning.
+;;
+
+(define* (create-adjacent-partitions disk partitions
+ #:key (last-partition-end 0))
+ "Create the given PARTITIONS on DISK. LAST-PARTITION-END is the sector from
+which we want to start creating partitions. The START and END of each created
+partition are computed from its SIZE value and the position of the last
+partition."
+ (let ((device (disk-device disk)))
+ (let loop ((partitions partitions)
+ (remaining-space (- (device-length device)
+ last-partition-end))
+ (start last-partition-end))
+ (match partitions
+ (() '())
+ ((partition . rest)
+ (let* ((size (user-partition-size partition))
+ (percentage-size (and (string? size)
+ (read-percentage size)))
+ (sector-size (device-sector-size device))
+ (partition-size (if percentage-size
+ (exact->inexact
+ (* (/ percentage-size 100)
+ remaining-space))
+ size))
+ (end-partition (min (- (device-length device) 1)
+ (nearest-exact-integer
+ (+ start partition-size 1))))
+ (name (user-partition-name partition))
+ (type (user-partition-type partition))
+ (fs-type (user-partition-fs-type partition))
+ (start-formatted (unit-format-custom device
+ start
+ UNIT-SECTOR))
+ (end-formatted (unit-format-custom device
+ end-partition
+ UNIT-SECTOR))
+ (new-user-partition (user-partition
+ (inherit partition)
+ (start start-formatted)
+ (end end-formatted)))
+ (new-partition
+ (mkpart disk new-user-partition)))
+ (if new-partition
+ (cons (user-partition
+ (inherit new-user-partition)
+ (path (partition-get-path new-partition))
+ (disk-path (device-path device))
+ (parted-object new-partition))
+ (loop rest
+ (if (eq? type 'extended)
+ remaining-space
+ (- remaining-space
+ (partition-length new-partition)))
+ (if (eq? type 'extended)
+ (+ start 1)
+ (+ (partition-end new-partition) 1))))
+ (error
+ (format #f "Unable to create partition ~a~%" name)))))))))
+
+(define (force-user-partitions-formating user-partitions)
+ "Set the NEED-FORMATING? fields to #t on all <user-partition> records of
+USER-PARTITIONS list and return the updated list."
+ (map (lambda (p)
+ (user-partition
+ (inherit p)
+ (need-formating? #t)))
+ user-partitions))
+
+(define* (auto-partition disk
+ #:key (scheme 'entire-root))
+ "Automatically create partitions on DISK. All the previous
+partitions (except the ESP on a GPT disk, if present) are wiped. SCHEME is the
+desired partitioning scheme. It can be 'entire-root or
+'entire-root-home. 'entire-root will create a swap partition and a root
+partition occupying all the remaining space. 'entire-root-home will create a
+swap partition, a root partition and a home partition."
+ (let* ((device (disk-device disk))
+ (disk-type (disk-disk-type disk))
+ (has-extended? (disk-type-check-feature
+ disk-type
+ DISK-TYPE-FEATURE-EXTENDED))
+ (partitions (filter data-partition? (disk-partitions disk)))
+ (esp-partition (find-esp-partition partitions))
+ ;; According to
+ ;; https://wiki.archlinux.org/index.php/EFI_system_partition, the ESP
+ ;; size should be at least 550MiB.
+ (new-esp-size (nearest-exact-integer
+ (/ (* 550 MEBIBYTE-SIZE)
+ (device-sector-size device))))
+ (end-esp-partition (and esp-partition
+ (partition-end esp-partition)))
+ (non-boot-partitions (remove esp-partition? partitions))
+ (bios-grub-size (/ (* 3 MEBIBYTE-SIZE)
+ (device-sector-size device)))
+ (five-percent-disk (nearest-exact-integer
+ (* 0.05 (device-length device))))
+ (default-swap-size (nearest-exact-integer
+ (/ (* 4 GIGABYTE-SIZE)
+ (device-sector-size device))))
+ ;; Use a 4GB size for the swap if it represents less than 5% of the
+ ;; disk space. Otherwise, set the swap size to 5% of the disk space.
+ (swap-size (min default-swap-size five-percent-disk)))
+
+ (if has-extended?
+ ;; msdos - remove everything.
+ (disk-delete-all disk)
+ ;; gpt - remove everything but esp if it exists.
+ (for-each
+ (lambda (partition)
+ (and (data-partition? partition)
+ (disk-remove-partition disk partition)))
+ non-boot-partitions))
+
+ (let* ((start-partition
+ (and (not has-extended?)
+ (not esp-partition)
+ (if (efi-installation?)
+ (user-partition
+ (fs-type 'fat32)
+ (esp? #t)
+ (size new-esp-size)
+ (mount-point (default-esp-mount-point)))
+ (user-partition
+ (fs-type 'ext4)
+ (bootable? #t)
+ (bios-grub? #t)
+ (size bios-grub-size)))))
+ (new-partitions
+ (case scheme
+ ((entire-root)
+ `(,@(if start-partition
+ `(,start-partition)
+ '())
+ ,(user-partition
+ (fs-type 'swap)
+ (size swap-size))
+ ,(user-partition
+ (fs-type 'ext4)
+ (bootable? has-extended?)
+ (size "100%")
+ (mount-point "/"))))
+ ((entire-root-home)
+ `(,@(if start-partition
+ `(,start-partition)
+ '())
+ ,(user-partition
+ (fs-type 'ext4)
+ (bootable? has-extended?)
+ (size "33%")
+ (mount-point "/"))
+ ,@(if has-extended?
+ `(,(user-partition
+ (type 'extended)
+ (size "100%")))
+ '())
+ ,(user-partition
+ (type (if has-extended?
+ 'logical
+ 'normal))
+ (fs-type 'swap)
+ (size swap-size))
+ ,(user-partition
+ (type (if has-extended?
+ 'logical
+ 'normal))
+ (fs-type 'ext4)
+ (size "100%")
+ (mount-point "/home"))))))
+ (new-partitions* (force-user-partitions-formating
+ new-partitions)))
+ (create-adjacent-partitions disk
+ new-partitions*
+ #:last-partition-end
+ (or end-esp-partition 0)))))
+
+
+;;
+;; Convert user-partitions.
+;;
+
+;; No root mount point found.
+(define-condition-type &no-root-mount-point &condition
+ no-root-mount-point?)
+
+(define (check-user-partitions user-partitions)
+ "Return #t if the USER-PARTITIONS lists contains one <user-partition> record
+with a mount-point set to '/', raise &no-root-mount-point condition
+otherwise."
+ (let ((mount-points
+ (map user-partition-mount-point user-partitions)))
+ (or (member "/" mount-points)
+ (raise
+ (condition (&no-root-mount-point))))))
+
+(define (set-user-partitions-path user-partitions)
+ "Set the partition path of <user-partition> records in USER-PARTITIONS list
+and return the updated list."
+ (map (lambda (p)
+ (let* ((partition (user-partition-parted-object p))
+ (path (partition-get-path partition)))
+ (user-partition
+ (inherit p)
+ (path path))))
+ user-partitions))
+
+(define-syntax-rule (with-null-output-ports exp ...)
+ "Evaluate EXP with both the output port and the error port pointing to the
+bit bucket."
+ (with-output-to-port (%make-void-port "w")
+ (lambda ()
+ (with-error-to-port (%make-void-port "w")
+ (lambda () exp ...)))))
+
+(define (create-ext4-file-system partition)
+ "Create an ext4 file-system for PARTITION path."
+ (with-null-output-ports
+ (invoke "mkfs.ext4" "-F" partition)))
+
+(define (create-fat32-file-system partition)
+ "Create an ext4 file-system for PARTITION path."
+ (with-null-output-ports
+ (invoke "mkfs.fat" "-F32" partition)))
+
+(define (create-swap-partition partition)
+ "Set up swap area on PARTITION path."
+ (with-null-output-ports
+ (invoke "mkswap" "-f" partition)))
+
+(define (start-swaping partition)
+ "Start swaping on PARTITION path."
+ (with-null-output-ports
+ (invoke "swapon" partition)))
+
+(define (stop-swaping partition)
+ "Stop swaping on PARTITION path."
+ (with-null-output-ports
+ (invoke "swapoff" partition)))
+
+(define (format-user-partitions user-partitions)
+ "Format the <user-partition> records in USER-PARTITIONS list with
+NEED-FORMATING? field set to #t."
+ (for-each
+ (lambda (user-partition)
+ (let* ((need-formating?
+ (user-partition-need-formating? user-partition))
+ (type (user-partition-type user-partition))
+ (path (user-partition-path user-partition))
+ (fs-type (user-partition-fs-type user-partition)))
+ (case fs-type
+ ((ext4)
+ (and need-formating?
+ (not (eq? type 'extended))
+ (create-ext4-file-system path)))
+ ((fat32)
+ (and need-formating?
+ (not (eq? type 'extended))
+ (create-fat32-file-system path)))
+ ((swap)
+ (create-swap-partition path))
+ (else
+ ;; TODO: Add support for other file-system types.
+ #t))))
+ user-partitions))
+
+(define (sort-partitions user-partitions)
+ "Sort USER-PARTITIONS by mount-points, so that the more nested mount-point
+comes last. This is useful to mount/umount partitions in a coherent order."
+ (sort user-partitions
+ (lambda (a b)
+ (let ((mount-point-a (user-partition-mount-point a))
+ (mount-point-b (user-partition-mount-point b)))
+ (string-prefix? mount-point-a mount-point-b)))))
+
+(define (mount-user-partitions user-partitions)
+ "Mount the <user-partition> records in USER-PARTITIONS list on their
+respective mount-points. Also start swaping on <user-partition> records with
+FS-TYPE equal to 'swap."
+ (let* ((mount-partitions (filter user-partition-mount-point user-partitions))
+ (sorted-partitions (sort-partitions mount-partitions)))
+ (for-each (lambda (user-partition)
+ (let* ((mount-point
+ (user-partition-mount-point user-partition))
+ (target
+ (string-append (%installer-target-dir)
+ mount-point))
+ (fs-type
+ (user-partition-fs-type user-partition))
+ (mount-type
+ (user-fs-type->mount-type fs-type))
+ (path (user-partition-path user-partition)))
+ (case fs-type
+ ((swap)
+ (start-swaping path))
+ (else
+ (mkdir-p target)
+ (mount path target mount-type)))))
+ sorted-partitions)))
+
+(define (umount-user-partitions user-partitions)
+ "Unmount all the <user-partition> records in USER-PARTITIONS list. Also stop
+swaping on <user-partition> with FS-TYPE set to 'swap."
+ (let* ((mount-partitions (filter user-partition-mount-point user-partitions))
+ (sorted-partitions (sort-partitions mount-partitions)))
+ (for-each (lambda (user-partition)
+ (let* ((mount-point
+ (user-partition-mount-point user-partition))
+ (fs-type
+ (user-partition-fs-type user-partition))
+ (path (user-partition-path user-partition))
+ (target
+ (string-append (%installer-target-dir)
+ mount-point)))
+ (case fs-type
+ ((swap)
+ (stop-swaping path))
+ (else
+ (umount target)))))
+ (reverse sorted-partitions))))
+
+(define-syntax-rule (with-mounted-partitions user-partitions exp ...)
+ "Mount USER-PARTITIONS within the dynamic extent of EXP."
+ (dynamic-wind
+ (lambda ()
+ (mount-user-partitions user-partitions))
+ (lambda ()
+ exp ...)
+ (lambda ()
+ (umount-user-partitions user-partitions)
+ #f)))
+
+(define (user-partition->file-system user-partition)
+ "Convert the given USER-PARTITION record in a FILE-SYSTEM record from
+(gnu system file-systems) module and return it."
+ (let* ((mount-point (user-partition-mount-point user-partition))
+ (fs-type (user-partition-fs-type user-partition))
+ (mount-type (user-fs-type->mount-type fs-type))
+ (path (user-partition-path user-partition))
+ (uuid (uuid->string (read-partition-uuid path)
+ fs-type)))
+ `(file-system
+ (mount-point ,mount-point)
+ (device (uuid ,uuid (quote ,fs-type)))
+ (type ,mount-type))))
+
+(define (user-partitions->file-systems user-partitions)
+ "Convert the given USER-PARTITIONS list of <user-partition> records into a
+list of <file-system> records."
+ (filter-map
+ (lambda (user-partition)
+ (let ((mount-point
+ (user-partition-mount-point user-partition)))
+ (and mount-point
+ (user-partition->file-system user-partition))))
+ user-partitions))
+
+(define (find-swap-user-partitions user-partitions)
+ "Return the subset of <user-partition> records in USER-PARTITIONS list with
+the FS-TYPE field set to 'swap, return the empty list if none found."
+ (filter (lambda (user-partition)
+ (let ((fs-type (user-partition-fs-type user-partition)))
+ (eq? fs-type 'swap)))
+ user-partitions))
+
+(define (bootloader-configuration user-partitions)
+ "Return the bootloader configuration field for USER-PARTITIONS."
+ (let* ((root-partition
+ (find (lambda (user-partition)
+ (let ((mount-point
+ (user-partition-mount-point user-partition)))
+ (and mount-point
+ (string=? mount-point "/"))))
+ user-partitions))
+ (root-partition-disk (user-partition-disk-path root-partition)))
+ `((bootloader-configuration
+ ,@(if (efi-installation?)
+ `((bootloader grub-efi-bootloader)
+ (target ,(default-esp-mount-point)))
+ `((bootloader grub-bootloader)
+ (target ,root-partition-disk)))))))
+
+(define (user-partitions->configuration user-partitions)
+ "Return the configuration field for USER-PARTITIONS."
+ (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
+ (swap-devices (map user-partition-path swap-user-partitions)))
+ `(,@(if (null? swap-devices)
+ '()
+ `((swap-devices (list ,@swap-devices))))
+ (bootloader ,@(bootloader-configuration user-partitions))
+ (file-systems (cons*
+ ,@(user-partitions->file-systems user-partitions)
+ %base-file-systems)))))
+
+
+;;
+;; Initialization.
+;;
+
+(define (init-parted)
+ "Initialize libparted support."
+ (probe-all-devices)
+ (exception-set-handler (lambda (exception)
+ EXCEPTION-OPTION-UNHANDLED)))
+
+(define (free-parted devices)
+ "Deallocate memory used for DEVICES in parted, force sync them and wait for
+the devices not to be used before returning."
+ ;; XXX: Formating and further operations on disk partition table may fail
+ ;; because the partition table changes are not synced, or because the device
+ ;; is still in use, even if parted should have finished editing
+ ;; partitions. This is not well understood, but syncing devices and waiting
+ ;; them to stop returning EBUSY to BLKRRPART ioctl seems to be enough. The
+ ;; same kind of issue is described here:
+ ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html.
+ (let ((device-paths (map device-path devices)))
+ (for-each force-device-sync devices)
+ (free-all-devices)
+ (for-each (lambda (path)
+ (let ((in-use? (with-delay-device-in-use? path)))
+ (and in-use?
+ (error
+ (format #f (G_ "Device ~a is still in use.")
+ path)))))
+ device-paths)))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 3ef0a10..edf73b6 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -35,6 +35,7 @@
installer-timezone-page
installer-hostname-page
installer-user-page
+ installer-partition-page
installer-services-page
installer-welcome-page))
@@ -76,6 +77,8 @@
;; procedure void -> void
(user-page installer-user-page)
;; procedure void -> void
+ (partition-page installer-partition-page)
+ ;; procedure void -> void
(services-page installer-services-page)
;; procedure (logo) -> void
(welcome-page installer-welcome-page))
diff --git a/gnu/local.mk b/gnu/local.mk
index 0b5e96a..63859a3 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -574,6 +574,7 @@ GNU_SYSTEM_MODULES += \
%D%/installer/keymap.scm \
%D%/installer/locale.scm \
%D%/installer/newt.scm \
+ %D%/installer/parted.scm \
%D%/installer/services.scm \
%D%/installer/steps.scm \
%D%/installer/timezone.scm \
@@ -588,6 +589,7 @@ GNU_SYSTEM_MODULES += \
%D%/installer/newt/menu.scm \
%D%/installer/newt/network.scm \
%D%/installer/newt/page.scm \
+ %D%/installer/newt/partition.scm \
%D%/installer/newt/services.scm \
%D%/installer/newt/timezone.scm \
%D%/installer/newt/utils.scm \
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 48c09a1..8327bf6 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -28,6 +28,7 @@ gnu/installer/newt/user.scm
gnu/installer/newt/utils.scm
gnu/installer/newt/welcome.scm
gnu/installer/newt/wifi.scm
+gnu/installer/parted.scm
gnu/installer/services.scm
gnu/installer/steps.scm
gnu/installer/timezone.scm
- 59/67: installer: welcome: Put "Graphical installer" ahead., (continued)
- 59/67: installer: welcome: Put "Graphical installer" ahead., guix-commits, 2019/01/16
- 55/67: installer: Various renamings., guix-commits, 2019/01/16
- 64/67: syscalls: 'device-in-use?' returns #f upon EINVAL., guix-commits, 2019/01/16
- 42/67: installer: network: Do not show an empty technology list., guix-commits, 2019/01/16
- 41/67: installer: keymap: Fix keymap selection of layouts with not variant., guix-commits, 2019/01/16
- 58/67: installer: Rename "Ok" buttons to "OK"., guix-commits, 2019/01/16
- 67/67: installer: Fix manual partitioning., guix-commits, 2019/01/16
- 61/67: installer: keymap: Put English layout and international variant ahead., guix-commits, 2019/01/16
- 56/67: installer: Various renamins follow-up., guix-commits, 2019/01/16
- 63/67: syscalls: 'device-in-use?' does not create a port., guix-commits, 2019/01/16
- 31/67: installer: Add partitioning support.,
guix-commits <=
- 51/67: installer: partionment: Add encryption support., guix-commits, 2019/01/16
- 04/67: gnu: Add graphical installer support., guix-commits, 2019/01/16