summaryrefslogtreecommitdiff
path: root/gnu/installer/parted.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer/parted.scm')
-rw-r--r--gnu/installer/parted.scm89
1 files changed, 60 insertions, 29 deletions
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index b36b238d8be..ccddc64f115 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -152,7 +152,7 @@
152 (crypt-password user-partition-crypt-password ; <secret> 152 (crypt-password user-partition-crypt-password ; <secret>
153 (default #f)) 153 (default #f))
154 (fs-type user-partition-fs-type 154 (fs-type user-partition-fs-type
155 (default 'ext4)) 155 (default (if (target-hurd?) 'ext2 'ext4)))
156 (bootable? user-partition-bootable? 156 (bootable? user-partition-bootable?
157 (default #f)) 157 (default #f))
158 (esp? user-partition-esp? 158 (esp? user-partition-esp?
@@ -223,11 +223,13 @@ inferior to MAX-SIZE, #f otherwise."
223 223
224(define (efi-installation?) 224(define (efi-installation?)
225 "Return #t if an EFI installation should be performed, #f otherwise." 225 "Return #t if an EFI installation should be performed, #f otherwise."
226 (file-exists? "/sys/firmware/efi")) 226 (and (file-exists? "/sys/firmware/efi")
227 (not (target-hurd?))))
227 228
228(define (user-fs-type-name fs-type) 229(define (user-fs-type-name fs-type)
229 "Return the name of FS-TYPE as specified by libparted." 230 "Return the name of FS-TYPE as specified by libparted."
230 (case fs-type 231 (case fs-type
232 ((ext2) "ext2")
231 ((ext4) "ext4") 233 ((ext4) "ext4")
232 ((btrfs) "btrfs") 234 ((btrfs) "btrfs")
233 ((fat16) "fat16") 235 ((fat16) "fat16")
@@ -240,6 +242,7 @@ inferior to MAX-SIZE, #f otherwise."
240(define (user-fs-type->mount-type fs-type) 242(define (user-fs-type->mount-type fs-type)
241 "Return the mount type of FS-TYPE." 243 "Return the mount type of FS-TYPE."
242 (case fs-type 244 (case fs-type
245 ((ext2) "ext2")
243 ((ext4) "ext4") 246 ((ext4) "ext4")
244 ((btrfs) "btrfs") 247 ((btrfs) "btrfs")
245 ((fat16) "vfat") 248 ((fat16) "vfat")
@@ -255,6 +258,7 @@ of <user-partition> record."
255 (and fs-type 258 (and fs-type
256 (let ((name (filesystem-type-name fs-type))) 259 (let ((name (filesystem-type-name fs-type)))
257 (cond 260 (cond
261 ((string=? name "ext2") 'ext2)
258 ((string=? name "ext4") 'ext4) 262 ((string=? name "ext4") 'ext4)
259 ((string=? name "btrfs") 'btrfs) 263 ((string=? name "btrfs") 'btrfs)
260 ((string=? name "fat16") 'fat16) 264 ((string=? name "fat16") 'fat16)
@@ -296,7 +300,7 @@ of <user-partition> record."
296 (file-name (partition-get-path partition)) 300 (file-name (partition-get-path partition))
297 (disk-file-name (device-path device)) 301 (disk-file-name (device-path device))
298 (fs-type (or (partition-filesystem-user-type partition) 302 (fs-type (or (partition-filesystem-user-type partition)
299 'ext4)) 303 (if (target-hurd?) 'ext2 'ext4)))
300 (mount-point (and (esp-partition? partition) 304 (mount-point (and (esp-partition? partition)
301 (default-esp-mount-point))) 305 (default-esp-mount-point)))
302 (bootable? (boot-partition? partition)) 306 (bootable? (boot-partition? partition))
@@ -1045,18 +1049,20 @@ exists."
1045 non-boot-partitions) 1049 non-boot-partitions)
1046 1050
1047 (let* ((start-partition 1051 (let* ((start-partition
1048 (if (efi-installation?) 1052 (cond ((target-hurd?) #f)
1049 (and (not esp-partition) 1053 ((efi-installation?)
1050 (user-partition 1054 (and (not esp-partition)
1051 (fs-type 'fat32) 1055 (user-partition
1052 (esp? #t) 1056 (fs-type 'fat32)
1053 (size new-esp-size) 1057 (esp? #t)
1054 (mount-point (default-esp-mount-point)))) 1058 (size new-esp-size)
1055 (user-partition 1059 (mount-point (default-esp-mount-point)))))
1056 (fs-type 'ext4) 1060 (else
1057 (bootable? #t) 1061 (user-partition
1058 (bios-grub? #t) 1062 (fs-type 'ext4)
1059 (size bios-grub-size)))) 1063 (bootable? #t)
1064 (bios-grub? #t)
1065 (size bios-grub-size)))))
1060 (new-partitions 1066 (new-partitions
1061 (cond 1067 (cond
1062 ((or (eq? scheme 'entire-root) 1068 ((or (eq? scheme 'entire-root)
@@ -1065,13 +1071,13 @@ exists."
1065 `(,@(if start-partition 1071 `(,@(if start-partition
1066 `(,start-partition) 1072 `(,start-partition)
1067 '()) 1073 '())
1068 ,@(if encrypted? 1074 ,@(if (or encrypted? (target-hurd?))
1069 '() 1075 '()
1070 `(,(user-partition 1076 `(,(user-partition
1071 (fs-type 'swap) 1077 (fs-type 'swap)
1072 (size swap-size)))) 1078 (size swap-size))))
1073 ,(user-partition 1079 ,(user-partition
1074 (fs-type 'ext4) 1080 (fs-type (if (target-hurd?) 'ext2 'ext4))
1075 (bootable? has-extended?) 1081 (bootable? has-extended?)
1076 (crypt-label (and encrypted? "cryptroot")) 1082 (crypt-label (and encrypted? "cryptroot"))
1077 (size "100%") 1083 (size "100%")
@@ -1083,7 +1089,7 @@ exists."
1083 `(,start-partition) 1089 `(,start-partition)
1084 '()) 1090 '())
1085 ,(user-partition 1091 ,(user-partition
1086 (fs-type 'ext4) 1092 (fs-type (if (target-hurd?) 'ext2 'ext4))
1087 (bootable? has-extended?) 1093 (bootable? has-extended?)
1088 (crypt-label (and encrypted? "cryptroot")) 1094 (crypt-label (and encrypted? "cryptroot"))
1089 (size "33%") 1095 (size "33%")
@@ -1105,7 +1111,7 @@ exists."
1105 (type (if has-extended? 1111 (type (if has-extended?
1106 'logical 1112 'logical
1107 'normal)) 1113 'normal))
1108 (fs-type 'ext4) 1114 (fs-type (if (target-hurd?) 'ext2 'ext4))
1109 (crypt-label (and encrypted? "crypthome")) 1115 (crypt-label (and encrypted? "crypthome"))
1110 (size "100%") 1116 (size "100%")
1111 (mount-point "/home"))))))) 1117 (mount-point "/home")))))))
@@ -1186,6 +1192,15 @@ list and return the updated list."
1186 "Create a btrfs file-system for PARTITION file-name." 1192 "Create a btrfs file-system for PARTITION file-name."
1187 ((%run-command-in-installer) "mkfs.btrfs" "-f" partition)) 1193 ((%run-command-in-installer) "mkfs.btrfs" "-f" partition))
1188 1194
1195(define (create-ext2-file-system partition)
1196 "Create an ext2 file-system for PARTITION file-name, when TARGET-HURD?,
1197for the Hurd."
1198 (apply (%run-command-in-installer)
1199 `("mkfs.ext2" ,@(if (target-hurd?)
1200 '("-o" "hurd")
1201 '())
1202 "-F" ,partition)))
1203
1189(define (create-ext4-file-system partition) 1204(define (create-ext4-file-system partition)
1190 "Create an ext4 file-system for PARTITION file-name." 1205 "Create an ext4 file-system for PARTITION file-name."
1191 ;; Enable the 'large_dir' feature so users can have a store of several TiBs. 1206 ;; Enable the 'large_dir' feature so users can have a store of several TiBs.
@@ -1291,6 +1306,10 @@ NEED-FORMATTING? field set to #t."
1291 (and need-formatting? 1306 (and need-formatting?
1292 (not (eq? type 'extended)) 1307 (not (eq? type 'extended))
1293 (create-btrfs-file-system file-name))) 1308 (create-btrfs-file-system file-name)))
1309 ((ext2)
1310 (and need-formatting?
1311 (not (eq? type 'extended))
1312 (create-ext2-file-system file-name)))
1294 ((ext4) 1313 ((ext4)
1295 (and need-formatting? 1314 (and need-formatting?
1296 (not (eq? type 'extended)) 1315 (not (eq? type 'extended))
@@ -1463,7 +1482,11 @@ from (gnu system mapped-devices) and return it."
1463 "Return the bootloader configuration field for USER-PARTITIONS." 1482 "Return the bootloader configuration field for USER-PARTITIONS."
1464 (let ((root-partition (find root-user-partition? user-partitions))) 1483 (let ((root-partition (find root-user-partition? user-partitions)))
1465 (match user-partitions 1484 (match user-partitions
1466 (() '()) 1485 (() (if (target-hurd?)
1486 '(bootloader-configuration
1487 (bootloader grub-minimal-bootloader)
1488 (targets "/dev/sdaX"))
1489 '()))
1467 (_ 1490 (_
1468 (let ((root-partition-disk (user-partition-disk-file-name 1491 (let ((root-partition-disk (user-partition-disk-file-name
1469 root-partition))) 1492 root-partition)))
@@ -1471,7 +1494,9 @@ from (gnu system mapped-devices) and return it."
1471 ,@(if (efi-installation?) 1494 ,@(if (efi-installation?)
1472 `((bootloader grub-efi-bootloader) 1495 `((bootloader grub-efi-bootloader)
1473 (targets (list ,(default-esp-mount-point)))) 1496 (targets (list ,(default-esp-mount-point))))
1474 `((bootloader grub-bootloader) 1497 `((bootloader ,(if (target-hurd?)
1498 'grub-minimal-bootloader
1499 'grub-bootloader))
1475 (targets (list ,root-partition-disk)))) 1500 (targets (list ,root-partition-disk))))
1476 1501
1477 ;; XXX: Assume we defined the 'keyboard-layout' field of 1502 ;; XXX: Assume we defined the 'keyboard-layout' field of
@@ -1491,22 +1516,28 @@ modules to access USER-PARTITIONS."
1491 (const '()))) 1516 (const '())))
1492 (delete-duplicates 1517 (delete-duplicates
1493 (map user-partition-file-name 1518 (map user-partition-file-name
1494 (cons root devices))))))) 1519 (filter identity
1520 (cons root devices))))))))
1495 1521
1496(define (initrd-configuration user-partitions) 1522(define (initrd-configuration user-partitions)
1497 "Return an 'initrd-modules' field with everything needed for 1523 "Return an 'initrd-modules' field with everything needed for
1498USER-PARTITIONS, or return nothing." 1524USER-PARTITIONS, or return nothing."
1499 (match (user-partition-missing-modules user-partitions) 1525 (if (target-hurd?)
1500 (() 1526 '((initrd #f)
1501 '()) 1527 (initrd-modules '()))
1502 ((modules ...) 1528 (match (user-partition-missing-modules user-partitions)
1503 `((initrd-modules (append ',modules 1529 (()
1504 %base-initrd-modules)))))) 1530 '())
1531 ((modules ...)
1532 `((initrd-modules (append ',modules
1533 %base-initrd-modules)))))))
1505 1534
1506(define (user-partitions->configuration user-partitions) 1535(define (user-partitions->configuration user-partitions)
1507 "Return the configuration field for USER-PARTITIONS." 1536 "Return the configuration field for USER-PARTITIONS."
1508 (let* ((swap-user-partitions (find-swap-user-partitions user-partitions)) 1537 (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
1509 (swap-devices (map user-partition-file-name swap-user-partitions)) 1538 (swap-devices (if (target-hurd?)
1539 '()
1540 (map user-partition-file-name swap-user-partitions)))
1510 (encrypted-partitions 1541 (encrypted-partitions
1511 (filter user-partition-crypt-label user-partitions))) 1542 (filter user-partition-crypt-label user-partitions)))
1512 `((bootloader ,@(bootloader-configuration user-partitions)) 1543 `((bootloader ,@(bootloader-configuration user-partitions))