;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès ;;; ;;; 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 . (define-module (test-ui) #:use-module (guix ui) #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix derivations) #:use-module ((gnu packages) #:select (specification->package)) #:use-module (guix tests) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) #:use-module (ice-9 regex)) ;; Test the (guix ui) module. (define %paragraph "GNU Guile is an implementation of the Scheme programming language, with support for many SRFIs, packaged for use in a wide variety of environments. In addition to implementing the R5RS Scheme standard and a large subset of R6RS, Guile includes a module system, full access to POSIX system calls, networking support, multiple threads, dynamic linking, a foreign function call interface, and powerful string processing.") (define guile-1.8.8 (manifest-entry (name "guile") (version "1.8.8") (item "/gnu/store/...") (output "out"))) (define guile-2.0.9 (manifest-entry (name "guile") (version "2.0.9") (item "/gnu/store/...") (output "out")
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;;
;;; 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 (canonicalize-device-spec
                          find-partition-by-label
                          find-partition-by-uuid
                          read-partition-uuid
                          read-luks-partition-uuid))
  #:use-module ((gnu build linux-boot)
                #:select (linux-command-line
                          find-long-option))
  #:use-module ((gnu build linux-modules)
                #:select (missing-modules))
  #:use-module ((gnu system linux-initrd)
                #:select (%base-initrd-modules))
  #:use-module (guix build syscalls)
  #:use-module (guix build utils)
  #:use-module (guix read-print)
  #:use-module (guix records)
  #:use-module (guix utils)
  #:use-module (guix i18n)
  #:use-module (parted)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (rnrs io ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #: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-file-name
            user-partition-disk-file-name
            user-partition-crypt-label
            user-partition-crypt-password
            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-formatting?
            user-partition-parted-object

            find-esp-partition
            small-freespace-partition?
            esp-partition?
            boot-partition?
            efi-installation?
            default-esp-mount-point

            force-device-sync
            eligible-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

            auto-partition!

            &no-root-mount-point
            no-root-mount-point?
            &cannot-read-uuid
            cannot-read-uuid?
            cannot-read-uuid-partition

            check-user-partitions
            set-user-partitions-file-name
            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
  (file-name            user-partition-file-name
                        (default #f))
  (disk-file-name       user-partition-disk-file-name
                        (default #f))
  (crypt-label          user-partition-crypt-label
                        (default #f))
  (crypt-password       user-partition-crypt-password ; <secret>
                        (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-formatting?     user-partition-need-formatting? ; 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* (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-secto