From patchwork Tue Sep 24 12:26:03 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 15443 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 25F971742D; Tue, 24 Sep 2019 13:27:23 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,FREEMAIL_FROM, T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id C86F51741F for ; Tue, 24 Sep 2019 13:27:22 +0100 (BST) Received: from localhost ([::1]:45040 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iCjuc-0008Uv-CQ for patchwork@mira.cbaines.net; Tue, 24 Sep 2019 08:27:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49463) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iCjuJ-0008Ui-Jt for guix-patches@gnu.org; Tue, 24 Sep 2019 08:27:04 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iCjuI-0008Kh-5U for guix-patches@gnu.org; Tue, 24 Sep 2019 08:27:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:57267) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iCjuI-0008KW-2L for guix-patches@gnu.org; Tue, 24 Sep 2019 08:27:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iCjuH-0001yg-T8 for guix-patches@gnu.org; Tue, 24 Sep 2019 08:27:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#37497] [PATCH] installer: Update to Guile-Parted 0.0.2 release. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 24 Sep 2019 12:27:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 37497 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 37497@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.15693279807546 (code B ref -1); Tue, 24 Sep 2019 12:27:01 +0000 Received: (at submit) by debbugs.gnu.org; 24 Sep 2019 12:26:20 +0000 Received: from localhost ([127.0.0.1]:37855 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iCjtc-0001xe-ET for submit@debbugs.gnu.org; Tue, 24 Sep 2019 08:26:20 -0400 Received: from lists.gnu.org ([209.51.188.17]:49917) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iCjtb-0001xX-7t for submit@debbugs.gnu.org; Tue, 24 Sep 2019 08:26:19 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49420) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iCjtZ-0008Q6-H6 for guix-patches@gnu.org; Tue, 24 Sep 2019 08:26:19 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iCjtX-0007mP-Hl for guix-patches@gnu.org; Tue, 24 Sep 2019 08:26:17 -0400 Received: from mail-wm1-x343.google.com ([2a00:1450:4864:20::343]:33094) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iCjtV-0007jg-JU for guix-patches@gnu.org; Tue, 24 Sep 2019 08:26:15 -0400 Received: by mail-wm1-x343.google.com with SMTP id r17so1516274wme.0 for ; Tue, 24 Sep 2019 05:26:12 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=Cqf2kuCUUFih2d4rt+sRKUIdiq+UdYkxb0E6DnJKeZY=; b=VgRf5ILidPe21KLFnR0CEqsmlaC76VaBIVTomu2zqAUmPDa1NPOLV0SoVcH4a5OmXU EzmR8CV8teHOQez6RC2bVm4gJK4nc3+QwQcdfyduaSUCvW8BCB1CF130eA6rkKrIGeQm Vj29+civlPYtu14/RvSJibdmwdBIXZIlO3BPt24/10+m+CNqawuWi8yPtEvaiiBgJZvd ofOTIMzoYrN6xrtokIufPrpV16Ve/9Gat5ZLS7VKRQ0Srcfe+iahTVLGF8qi8/DY8Fbw NLyO2TRWh/Po4zSw894rOJF66K9re939paPNrzyB3q7sJhd0CBwgjtmT/NugwMdQy/rG G7ng== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=Cqf2kuCUUFih2d4rt+sRKUIdiq+UdYkxb0E6DnJKeZY=; b=qbEue5YoqQxnmT4Jna3NFkwHLh4aKN9UIjpDw7vXiTIQTTmnj84hDIOSrIS76j8Wq1 93ah/GrBTnBI3qudCqzwTI5Hll2RrFScE2iFLaefxBg7lHSuVr3LiV3fFa3SiwecN48p SKAwhV1dOma0uW32Q7i3GWZ1K6BK3W0b7k4zyHv5MOc3g6VlAmJvtY21D5hCaXOl0HTA o3OaEBgu/8FDhlXHRFu3lvRJoZWu7yPen8ALa6wAcnjPG6jQJHqjR0CxC8ouTTHbhc91 x7hoGUwocPcyfN2fJCLqbh/ojcnxyp/WjZwZhKwqILEg2E9eIUU1fYQfw4IandwSbwcY H/5Q== X-Gm-Message-State: APjAAAVBsxmVXvksJGX1eYnq1uUs0/paKcw6DDSgTP9RMDp41IA4933Q 1Gtus3BCZOp3fkIhNNAIZ7jO8FQRs3A= X-Google-Smtp-Source: APXvYqyKxGwPJxWzhIdW8uQbSkKZCuyLDntbmSJ+AyQs55cYvCVr6WeRIm0eu9D8QuVJZ0g6tsmBzQ== X-Received: by 2002:a1c:c506:: with SMTP id v6mr2336905wmf.160.1569327970925; Tue, 24 Sep 2019 05:26:10 -0700 (PDT) Received: from localhost.localdomain ([90.114.71.216]) by smtp.gmail.com with ESMTPSA id y186sm4306417wmd.26.2019.09.24.05.26.08 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 24 Sep 2019 05:26:09 -0700 (PDT) From: Mathieu Othacehe Date: Tue, 24 Sep 2019 14:26:03 +0200 Message-Id: <20190924122603.25583-1-m.othacehe@gmail.com> X-Mailer: git-send-email 2.23.0 MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Mathieu Othacehe Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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*. --- gnu/installer/newt/partition.scm | 9 ++---- gnu/installer/parted.scm | 48 +++----------------------------- 2 files changed, 7 insertions(+), 50 deletions(-) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 7a9f11a15e..74e9473171 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -587,7 +587,6 @@ edit it." 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) @@ -625,7 +624,7 @@ edit it." info-text))) (case result ((1) - (disk-delete-all item) + (disk-remove-all-partitions item) `((disks . ,disks) (user-partitions . ,(remove-user-partition-by-disk user-partitions item)))) @@ -649,7 +648,7 @@ edit it." (let ((new-user-partitions (remove-user-partition-by-partition user-partitions item))) - (disk-delete-partition disk item) + (disk-remove-partition* disk item) `((disks . ,disks) (user-partitions . ,new-user-partitions)))) (else @@ -696,9 +695,7 @@ by pressing the Exit button.~%~%"))) #f)) (check-user-partitions user-partitions)))) (if user-partitions-ok? - (begin - (for-each (cut disk-destroy <>) disks) - user-partitions) + user-partitions (run-disk-page disks user-partitions #:guided? guided?))) (let* ((result-disks (assoc-ref result 'disks)) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 682e233d9f..3439f211e2 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -64,13 +64,7 @@ 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 @@ -172,24 +166,6 @@ "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)) @@ -200,21 +176,6 @@ inferior to MAX-SIZE, #f otherwise." (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 record. It can be 'normal, 'extended or 'logical." @@ -813,7 +774,7 @@ cause them to cross." (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))) + (disk-remove-partition* disk partition))) ;; @@ -928,12 +889,12 @@ exists." (if has-extended? ;; msdos - remove everything. - (disk-delete-all disk) + (disk-remove-all-partitions disk) ;; gpt - remove everything but esp if it exists. (for-each (lambda (partition) (and (data-partition? partition) - (disk-remove-partition disk partition))) + (disk-remove-partition* disk partition))) non-boot-partitions)) (let* ((start-partition @@ -1348,7 +1309,7 @@ USER-PARTITIONS, or return nothing." (define (init-parted) "Initialize libparted support." - (probe-all-devices) + (probe-all-devices!) (exception-set-handler (lambda (exception) EXCEPTION-OPTION-UNHANDLED))) @@ -1364,7 +1325,6 @@ the devices not to be used before returning." ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html. (let ((device-file-names (map device-path devices))) (for-each force-device-sync devices) - (free-all-devices) (for-each (lambda (file-name) (let ((in-use? (with-delay-device-in-use? file-name))) (and in-use?