summaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2019-09-24 11:56:46 +0200
committerMathieu Othacehe <m.othacehe@gmail.com>2019-09-25 16:03:23 +0200
commit70c7b7c79920dd6500ba5e4e88fe147cc44923d8 (patch)
tree6c007b20c7fca3058c5ad1e658282377b5e0f352 /gnu/installer
parenta3246602a271540b3ab21eb904b287da4f324eb8 (diff)
installer: Update to Guile-Parted 0.0.2 release.
* gnu/installer/parted.scm (data-partition?, metadata-partition?, freespace-partition?, normal-partition?, extended-partition?, logical-partition?): Remove, as now provided by Guile-Parted. * gnu/installer/newt/partition.scm (run-disk-page): Remove disk-destroy calls, replace disk-delete-all by disk-remove-all-partitions and disk-delete-partition by disk-remove-partition*.
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/newt/partition.scm9
-rw-r--r--gnu/installer/parted.scm48
2 files changed, 7 insertions, 50 deletions
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 7a9f11a15e6..74e94731710 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -587,7 +587,6 @@ edit it."
587 disks)) 587 disks))
588 (new-user-partitions 588 (new-user-partitions
589 (remove-user-partition-by-disk user-partitions item))) 589 (remove-user-partition-by-disk user-partitions item)))
590 (disk-destroy item)
591 `((disks . ,(cons new-disk other-disks)) 590 `((disks . ,(cons new-disk other-disks))
592 (user-partitions . ,new-user-partitions))) 591 (user-partitions . ,new-user-partitions)))
593 `((disks . ,disks) 592 `((disks . ,disks)
@@ -625,7 +624,7 @@ edit it."
625 info-text))) 624 info-text)))
626 (case result 625 (case result
627 ((1) 626 ((1)
628 (disk-delete-all item) 627 (disk-remove-all-partitions item)
629 `((disks . ,disks) 628 `((disks . ,disks)
630 (user-partitions 629 (user-partitions
631 . ,(remove-user-partition-by-disk user-partitions item)))) 630 . ,(remove-user-partition-by-disk user-partitions item))))
@@ -649,7 +648,7 @@ edit it."
649 (let ((new-user-partitions 648 (let ((new-user-partitions
650 (remove-user-partition-by-partition user-partitions 649 (remove-user-partition-by-partition user-partitions
651 item))) 650 item)))
652 (disk-delete-partition disk item) 651 (disk-remove-partition* disk item)
653 `((disks . ,disks) 652 `((disks . ,disks)
654 (user-partitions . ,new-user-partitions)))) 653 (user-partitions . ,new-user-partitions))))
655 (else 654 (else
@@ -696,9 +695,7 @@ by pressing the Exit button.~%~%")))
696 #f)) 695 #f))
697 (check-user-partitions user-partitions)))) 696 (check-user-partitions user-partitions))))
698 (if user-partitions-ok? 697 (if user-partitions-ok?
699 (begin 698 user-partitions
700 (for-each (cut disk-destroy <>) disks)
701 user-partitions)
702 (run-disk-page disks user-partitions 699 (run-disk-page disks user-partitions
703 #:guided? guided?))) 700 #:guided? guided?)))
704 (let* ((result-disks (assoc-ref result 'disks)) 701 (let* ((result-disks (assoc-ref result 'disks))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 682e233d9f0..3439f211e24 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -64,13 +64,7 @@
64 user-partition-parted-object 64 user-partition-parted-object
65 65
66 find-esp-partition 66 find-esp-partition
67 data-partition?
68 metadata-partition?
69 freespace-partition?
70 small-freespace-partition? 67 small-freespace-partition?
71 normal-partition?
72 extended-partition?
73 logical-partition?
74 esp-partition? 68 esp-partition?
75 boot-partition? 69 boot-partition?
76 default-esp-mount-point 70 default-esp-mount-point
@@ -172,24 +166,6 @@
172 "Find and return the ESP partition among PARTITIONS." 166 "Find and return the ESP partition among PARTITIONS."
173 (find esp-partition? partitions)) 167 (find esp-partition? partitions))
174 168
175(define (data-partition? partition)
176 "Return #t if PARTITION is a partition dedicated to data (by opposition to
177freespace, metadata and protected partition types), return #f otherwise."
178 (let ((type (partition-type partition)))
179 (not (any (lambda (flag)
180 (member flag type))
181 '(free-space metadata protected)))))
182
183(define (metadata-partition? partition)
184 "Return #t if PARTITION is a metadata partition, #f otherwise."
185 (let ((type (partition-type partition)))
186 (member 'metadata type)))
187
188(define (freespace-partition? partition)
189 "Return #t if PARTITION is a free-space partition, #f otherwise."
190 (let ((type (partition-type partition)))
191 (member 'free-space type)))
192
193(define* (small-freespace-partition? device 169(define* (small-freespace-partition? device
194 partition 170 partition
195 #:key (max-size MEBIBYTE-SIZE)) 171 #:key (max-size MEBIBYTE-SIZE))
@@ -200,21 +176,6 @@ inferior to MAX-SIZE, #f otherwise."
200 (device-sector-size device)))) 176 (device-sector-size device))))
201 (< size max-sector-size))) 177 (< size max-sector-size)))
202 178
203(define (normal-partition? partition)
204 "return #t if partition is a normal partition, #f otherwise."
205 (let ((type (partition-type partition)))
206 (member 'normal type)))
207
208(define (extended-partition? partition)
209 "return #t if partition is an extended partition, #f otherwise."
210 (let ((type (partition-type partition)))
211 (member 'extended type)))
212
213(define (logical-partition? partition)
214 "Return #t if PARTITION is a logical partition, #f otherwise."
215 (let ((type (partition-type partition)))
216 (member 'logical type)))
217
218(define (partition-user-type partition) 179(define (partition-user-type partition)
219 "Return the type of PARTITION, to be stored in the TYPE field of 180 "Return the type of PARTITION, to be stored in the TYPE field of
220<user-partition> record. It can be 'normal, 'extended or 'logical." 181<user-partition> record. It can be 'normal, 'extended or 'logical."
@@ -813,7 +774,7 @@ cause them to cross."
813(define (rmpart disk number) 774(define (rmpart disk number)
814 "Remove the partition with the given NUMBER on DISK." 775 "Remove the partition with the given NUMBER on DISK."
815 (let ((partition (disk-get-partition disk number))) 776 (let ((partition (disk-get-partition disk number)))
816 (disk-remove-partition disk partition))) 777 (disk-remove-partition* disk partition)))
817 778
818 779
819;; 780;;
@@ -928,12 +889,12 @@ exists."
928 889
929 (if has-extended? 890 (if has-extended?
930 ;; msdos - remove everything. 891 ;; msdos - remove everything.
931 (disk-delete-all disk) 892 (disk-remove-all-partitions disk)
932 ;; gpt - remove everything but esp if it exists. 893 ;; gpt - remove everything but esp if it exists.
933 (for-each 894 (for-each
934 (lambda (partition) 895 (lambda (partition)
935 (and (data-partition? partition) 896 (and (data-partition? partition)
936 (disk-remove-partition disk partition))) 897 (disk-remove-partition* disk partition)))
937 non-boot-partitions)) 898 non-boot-partitions))
938 899
939 (let* ((start-partition 900 (let* ((start-partition
@@ -1348,7 +1309,7 @@ USER-PARTITIONS, or return nothing."
1348 1309
1349(define (init-parted) 1310(define (init-parted)
1350 "Initialize libparted support." 1311 "Initialize libparted support."
1351 (probe-all-devices) 1312 (probe-all-devices!)
1352 (exception-set-handler (lambda (exception) 1313 (exception-set-handler (lambda (exception)
1353 EXCEPTION-OPTION-UNHANDLED))) 1314 EXCEPTION-OPTION-UNHANDLED)))
1354 1315
@@ -1364,7 +1325,6 @@ the devices not to be used before returning."
1364 ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html. 1325 ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html.
1365 (let ((device-file-names (map device-path devices))) 1326 (let ((device-file-names (map device-path devices)))
1366 (for-each force-device-sync devices) 1327 (for-each force-device-sync devices)
1367 (free-all-devices)
1368 (for-each (lambda (file-name) 1328 (for-each (lambda (file-name)
1369 (let ((in-use? (with-delay-device-in-use? file-name))) 1329 (let ((in-use? (with-delay-device-in-use? file-name)))
1370 (and in-use? 1330 (and in-use?