installer: Add NTFS support.

[jackhill/guix/guix.git] / gnu / installer / parted.scm

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index c2b02c9..47e0a9e 100644 (file)
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -222,7 +222,8 @@ inferior to MAX-SIZE, #f otherwise."
     ((btrfs) "btrfs")
     ((fat16) "fat16")
     ((fat32) "fat32")
-    ((jfs) "jfs")
+    ((jfs)   "jfs")
+    ((ntfs)  "ntfs")
     ((swap)  "linux-swap")))
 
 (define (user-fs-type->mount-type fs-type)
@@ -232,7 +233,8 @@ inferior to MAX-SIZE, #f otherwise."
     ((btrfs) "btrfs")
     ((fat16) "fat")
     ((fat32) "vfat")
-    ((jfs) "jfs")))
+    ((jfs)   "jfs")
+    ((ntfs)  "ntfs")))
 
 (define (partition-filesystem-user-type partition)
   "Return the filesystem type of PARTITION, to be stored in the FS-TYPE field
@@ -246,6 +248,7 @@ of <user-partition> record."
             ((string=? name "fat16") 'fat16)
             ((string=? name "fat32") 'fat32)
             ((string=? name "jfs") 'jfs)
+            ((string=? name "ntfs") 'ntfs)
             ((or (string=? name "swsusp")
                  (string=? name "linux-swap(v0)")
                  (string=? name "linux-swap(v1)"))
@@ -1040,6 +1043,11 @@ bit bucket."
   (with-null-output-ports
    (invoke "jfs_mkfs" "-f" partition)))
 
+(define (create-ntfs-file-system partition)
+  "Create a JFS file-system for PARTITION file-name."
+  (with-null-output-ports
+   (invoke "mkfs.ntfs" "-F" "-f" partition)))
+
 (define (create-swap-partition partition)
   "Set up swap area on PARTITION file-name."
   (with-null-output-ports
@@ -1070,6 +1078,8 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
     (call-with-luks-key-file
      password
      (lambda (key-file)
+       (syslog "formatting and opening LUKS entry ~s at ~s~%"
+               label file-name)
        (system* "cryptsetup" "-q" "luksFormat" file-name key-file)
        (system* "cryptsetup" "open" "--type" "luks"
                 "--key-file" key-file file-name label)))))
@@ -1077,6 +1087,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
 (define (luks-close user-partition)
   "Close the encrypted partition pointed by USER-PARTITION."
   (let ((label (user-partition-crypt-label user-partition)))
+    (syslog "closing LUKS entry ~s~%" label)
     (system* "cryptsetup" "close" label)))
 
 (define (format-user-partitions user-partitions)
@@ -1114,6 +1125,10 @@ NEED-FORMATING? field set to #t."
           (and need-formatting?
                (not (eq? type 'extended))
                (create-jfs-file-system file-name)))
+         ((ntfs)
+          (and need-formatting?
+               (not (eq? type 'extended))
+               (create-ntfs-file-system file-name)))
          ((swap)
           (create-swap-partition file-name))
          (else
@@ -1150,6 +1165,7 @@ respective mount-points."
                        (file-name
                         (user-partition-upper-file-name user-partition)))
                   (mkdir-p target)
+                  (syslog "mounting ~s on ~s~%" file-name target)
                   (mount file-name target mount-type)))
               sorted-partitions)))
 
@@ -1165,6 +1181,7 @@ respective mount-points."
                        (target
                         (string-append (%installer-target-dir)
                                        mount-point)))
+                  (syslog "unmounting ~s~%" target)
                   (umount target)
                   (when crypt-label
                     (luks-close user-partition))))