02/05: installer: Add JFS support.

[guix-commits]

nckx pushed a commit to branch master
in repository guix.

commit 8fec416cec6ffa5e2f1647eda8090fef1b0f71ac
Author: Tobias Geerinckx-Rice <address@hidden>
Date:   Fri Jan 3 19:26:54 2020 +0100

    installer: Add JFS support.
    
    * gnu/installer/newt/partition.scm (run-fs-type-page): Add ‘jfs’ to the
    list box.
    * gnu/installer/parted.scm (user-fs-type-name, user-fs-type->mount-type)
    (partition-filesystem-user-type): Add ‘jfs’ mapping
    (create-jfs-file-system): New procedure.
    (format-user-partitions): Use it.
    * gnu/installer.scm (set-installer-path): Add jfsutils.
---
 gnu/installer.scm                |  6 ++++--
 gnu/installer/newt/partition.scm |  3 ++-
 gnu/installer/parted.scm         | 15 ++++++++++++++-
 3 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/gnu/installer.scm b/gnu/installer.scm
index 1676532..1676a91 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <address@hidden>
 ;;; Copyright © 2019 Ludovic Courtès <address@hidden>
-;;; Copyright © 2019 Tobias Geerinckx-Rice <address@hidden>
+;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,6 +32,7 @@
   #:use-module (gnu packages connman)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages disk)
+  #:use-module (gnu packages file-systems)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages guile-xyz)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
@@ -295,7 +296,8 @@ selected keymap."
                                cryptsetup
                                dosfstools ;mkfs.fat
                                e2fsprogs ;mkfs.ext4
-                               btrfs-progs
+                               btrfs-progs ;mkfs.btrfs
+                               jfsutils ;jfs_mkfs
                                kbd ;chvt
                                guix ;guix system init call
                                util-linux ;mkwap
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 74e9473..3cba7f7 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Mathieu Othacehe <address@hidden>
 ;;; Copyright © 2019 Ludovic Courtès <address@hidden>
+;;; Copyright © 2020 Tobias Geerinckx-Rice <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -120,7 +121,7 @@ Be careful, all data on the disk will be lost.")
   (run-listbox-selection-page
    #:info-text (G_ "Please select the file-system type for this partition.")
    #:title (G_ "File-system type")
-   #:listbox-items '(ext4 btrfs fat16 fat32 swap)
+   #:listbox-items '(ext4 btrfs fat16 fat32 jfs swap)
    #:listbox-item->text user-fs-type-name
    #:sort-listbox-items? #f
    #:button-text (G_ "Exit")
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 519996f..c2b02c9 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Mathieu Othacehe <address@hidden>
 ;;; Copyright © 2019 Ludovic Courtès <address@hidden>
+;;; Copyright © 2020 Tobias Geerinckx-Rice <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -221,6 +222,7 @@ inferior to MAX-SIZE, #f otherwise."
     ((btrfs) "btrfs")
     ((fat16) "fat16")
     ((fat32) "fat32")
+    ((jfs) "jfs")
     ((swap)  "linux-swap")))
 
 (define (user-fs-type->mount-type fs-type)
@@ -229,7 +231,8 @@ inferior to MAX-SIZE, #f otherwise."
     ((ext4)  "ext4")
     ((btrfs) "btrfs")
     ((fat16) "fat")
-    ((fat32) "vfat")))
+    ((fat32) "vfat")
+    ((jfs) "jfs")))
 
 (define (partition-filesystem-user-type partition)
   "Return the filesystem type of PARTITION, to be stored in the FS-TYPE field
@@ -242,6 +245,7 @@ of <user-partition> record."
             ((string=? name "btrfs") 'btrfs)
             ((string=? name "fat16") 'fat16)
             ((string=? name "fat32") 'fat32)
+            ((string=? name "jfs") 'jfs)
             ((or (string=? name "swsusp")
                  (string=? name "linux-swap(v0)")
                  (string=? name "linux-swap(v1)"))
@@ -1031,6 +1035,11 @@ bit bucket."
   (with-null-output-ports
    (invoke "mkfs.fat" "-F32" partition)))
 
+(define (create-jfs-file-system partition)
+  "Create a JFS file-system for PARTITION file-name."
+  (with-null-output-ports
+   (invoke "jfs_mkfs" "-f" partition)))
+
 (define (create-swap-partition partition)
   "Set up swap area on PARTITION file-name."
   (with-null-output-ports
@@ -1101,6 +1110,10 @@ NEED-FORMATING? field set to #t."
           (and need-formatting?
                (not (eq? type 'extended))
                (create-fat32-file-system file-name)))
+         ((jfs)
+          (and need-formatting?
+               (not (eq? type 'extended))
+               (create-jfs-file-system file-name)))
          ((swap)
           (create-swap-partition file-name))
          (else