[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/26: installer: Extend the 'file-system' concept to include swap space
From: |
John Darrington |
Subject: |
01/26: installer: Extend the 'file-system' concept to include swap spaces. |
Date: |
Sun, 22 Jan 2017 12:09:23 +0000 (UTC) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit 2019856810ff437d5823e7400c50c62a3600f4ba
Author: John Darrington <address@hidden>
Date: Mon Jan 16 13:54:15 2017 +0100
installer: Extend the 'file-system' concept to include swap spaces.
* gnu/system/installer/filesystems.scm (valid-file-system-types): New
variable.
(<file-system-spec-type>): Change to expect a symbol instead of a string
* gnu/system/installer/format.scm (format-page-key-handler) : Generalise the
code to execute commands somewhat.
* gnu/system/installer/mount-point.scm (mount-point-page-init): Deal with
the file-system-spec-type function returning a symbol.
---
gnu/system/installer/filesystems.scm | 20 +++++++++++-------
gnu/system/installer/format.scm | 38 ++++++++++++++++++++++++++--------
gnu/system/installer/mount-point.scm | 3 ++-
3 files changed, 44 insertions(+), 17 deletions(-)
diff --git a/gnu/system/installer/filesystems.scm
b/gnu/system/installer/filesystems.scm
index 93db3bf..e100bbd 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -56,12 +56,18 @@
file-system-spec?
(mount-point file-system-spec-mount-point)
(label file-system-spec-label)
- (type file-system-spec-type)
+ (type file-system-spec-type) ; symbol
(uuid file-system-spec-uuid))
+(define valid-file-system-types `(ext2 ext3 ext4 btrfs swap))
+
(define (make-file-system-spec mount-point label type)
(let ((uuid (slurp "uuidgen" identity)))
- (make-file-system-spec' mount-point label type (car uuid))))
+ (make-file-system-spec' mount-point label
+ (if (memq (string->symbol type)
valid-file-system-types)
+ (string->symbol type)
+ #f)
+ (car uuid))))
@@ -81,7 +87,9 @@
(fold (lambda (x prev)
(match x
((dev . fss)
- (if (absolute-file-name?
(file-system-spec-mount-point fss))
+ (if (or
+ (eq? (file-system-spec-type fss) 'swap)
+ (absolute-file-name?
(file-system-spec-mount-point fss)))
prev
(cons (file-system-spec-mount-point fss)
prev)))))
'()
@@ -117,10 +125,8 @@
(fold (lambda (x prev)
(match x
((dev . ($ <file-system-spec> mp label type uuid))
- (cond
- ((string-prefix? "ext" type) prev)
- ((equal? "btrfs" type) prev)
- (else (cons dev prev))))))
+ (if type prev
+ (cons dev prev)))))
'() mount-points)))
(if (null? partitions-without-filesystems)
diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
index 3a5f8af..d4840b0 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -107,16 +107,36 @@ match those uuids read from the respective partitions"
(lambda (x)
(match x
((dev . ($ <file-system-spec> mp label type uuid))
- (let ((cmd (string-append "mkfs." type)))
- (zero? (pipe-cmd window-port
- cmd cmd
- "-L" label
- "-U" uuid
- (if (equal? type "btrfs")
+ (let ((type-str (symbol->string type)))
+ (cond
+ ((string-prefix? "ext" type-str)
+ (let ((cmd (string-append "mkfs." type-str)))
+ (zero? (pipe-cmd window-port
+ cmd cmd
+ "-L" label
+ "-U" uuid
+ "-v"
+ dev))))
+
+ ((eq? type 'btrfs)
+ (let ((cmd (string-append "mkfs.btrfs")))
+ (zero? (pipe-cmd window-port
+ cmd cmd
+ "-L" label
+ "-U" uuid
"-f"
- "-v")
- dev))
- )))) mount-points)
+ dev))))
+
+ ((eq? type 'swap)
+ (let ((cmd (string-append "mkswap")))
+ (zero? (pipe-cmd window-port
+ cmd cmd
+ "-L" label
+ "-U" uuid
+ "-f"
+ dev))))
+
+ ))))) mount-points)
(close-port window-port))
diff --git a/gnu/system/installer/mount-point.scm
b/gnu/system/installer/mount-point.scm
index 5715a2f..3abf675 100644
--- a/gnu/system/installer/mount-point.scm
+++ b/gnu/system/installer/mount-point.scm
@@ -147,7 +147,8 @@
(form-set-value! form 'mount-point
(file-system-spec-mount-point fss))
(form-set-value! form 'fs-type
- (file-system-spec-type fss))))
+ (symbol->string
+ (file-system-spec-type fss)))))
(form-set-current-field form 0)
- branch wip-installer updated (613ab98 -> 61c0ffb), John Darrington, 2017/01/22
- 02/26: installer: Properly handle swap partitions when generating the configuration., John Darrington, 2017/01/22
- 07/26: gurses: Change highlighting from bold to inverse., John Darrington, 2017/01/22
- 04/26: installer: Do not add file systems which are invalid., John Darrington, 2017/01/22
- 10/26: installer: Check that swap spaces have not been assigned mount points, John Darrington, 2017/01/22
- 14/26: installer: Distinguish between Wifi encryption methods., John Darrington, 2017/01/22
- 01/26: installer: Extend the 'file-system' concept to include swap spaces.,
John Darrington <=
- 21/26: installer: Do not assume the root file system is of type "ext4"., John Darrington, 2017/01/22
- 17/26: installer: Note which types of file system are supported., John Darrington, 2017/01/22
- 25/26: installer: Emphasise that writing filesystems destroys existing data., John Darrington, 2017/01/22
- 05/26: installer: Fix bug where the selected item of main page was not indicated., John Darrington, 2017/01/22
- 08/26: gurses: form: Use match instead of car, cdr etc., John Darrington, 2017/01/22
- 03/26: installer: Do not allow the creation of invalid file-system specificaitons., John Darrington, 2017/01/22
- 15/26: gurses: Allow menu update to work for panel windows., John Darrington, 2017/01/22
- 18/26: gurses: Populate the choices box in forms., John Darrington, 2017/01/22
- 06/26: installer: Add an explanatory text to the main page., John Darrington, 2017/01/22
- 22/26: installer: mount-points page: Enlarge the forms window., John Darrington, 2017/01/22