[bug#38860] Support JFS!

[bug#38860] Support JFS!

[Tobias Geerinckx-Rice via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 213 bytes --]

Friends,

These should add JFS root support to Guix System.

There's a system test, which passes, but I need to do some more 
testing with external drives &c. when I get home.  Help welcome.

Kind regards,

T G-R

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#38860] [PATCH 1/7] file-systems: Add support for JFS.

[Tobias Geerinckx-Rice via Guix-patches via]

* gnu/build/file-systems.scm (%jfs-endianness): New syntax.
(jfs-superblock?, read-jfs-superblock, jfs-superblock-uuid)
(jfs-superblock-volume-name, check-jfs-file-system): New procedures.
(%partition-label-readers, %partition-uuid-readers, check-file-system):
Register them.
---
 gnu/build/file-systems.scm | 49 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 47 insertions(+), 2 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 13c44aa728..9299cc2e4c 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -294,6 +295,45 @@ string.  Trailing spaces are trimmed."
   (string-trim-right (latin1->string (sub-bytevector sblock 40 32)
                                      (lambda (c) #f)) #\space))
 
+\f
+;;;
+;;; JFS file systems.
+;;;
+
+;; Taken from <linux-libre>/fs/jfs/jfs_superblock.h.
+
+(define-syntax %jfs-endianness
+  ;; Endianness of JFS file systems.
+  (identifier-syntax (endianness little)))
+
+(define (jfs-superblock? sblock)
+  "Return #t when SBLOCK is a JFS superblock."
+  (bytevector=? (sub-bytevector sblock 0 4)
+                (string->utf8 "JFS1")))
+
+(define (read-jfs-superblock device)
+  "Return the raw contents of DEVICE's JFS superblock as a bytevector, or #f
+if DEVICE does not contain a JFS file system."
+  (read-superblock device 32768 184 jfs-superblock?))
+
+(define (jfs-superblock-uuid sblock)
+  "Return the UUID of JFS superblock SBLOCK as a 16-byte bytevector."
+  (sub-bytevector sblock 136 16))
+
+(define (jfs-superblock-volume-name sblock)
+  "Return the volume name of SBLOCK as a string of at most 16 characters, or
+#f if SBLOCK has no volume name."
+  (null-terminated-latin1->string (sub-bytevector sblock 152 16)))
+
+(define (check-jfs-file-system device)
+  "Return the health of a JFS file system on DEVICE."
+  (match (status:exit-val
+          (system* "jfs_fsck" "-p" "-v" device))
+    (0 'pass)
+    (1 'errors-corrected)
+    (2 'reboot-required)
+    (_ 'fatal-error)))
+
 \f
 ;;;
 ;;; LUKS encrypted devices.
@@ -420,7 +460,9 @@ partition field reader that returned a value."
         (partition-field-reader read-fat32-superblock
                                 fat32-superblock-volume-name)
         (partition-field-reader read-fat16-superblock
-                                fat16-superblock-volume-name)))
+                                fat16-superblock-volume-name)
+        (partition-field-reader read-jfs-superblock
+                                jfs-superblock-volume-name)))
 
 (define %partition-uuid-readers
   (list (partition-field-reader read-iso9660-superblock
@@ -432,7 +474,9 @@ partition field reader that returned a value."
         (partition-field-reader read-fat32-superblock
                                 fat32-superblock-uuid)
         (partition-field-reader read-fat16-superblock
-                                fat16-superblock-uuid)))
+                                fat16-superblock-uuid)
+        (partition-field-reader read-jfs-superblock
+                                jfs-superblock-uuid)))
 
 (define read-partition-label
   (cut read-partition-field <> %partition-label-readers))
@@ -527,6 +571,7 @@ were found."
      ((string-prefix? "ext" type) check-ext2-file-system)
      ((string-prefix? "btrfs" type) check-btrfs-file-system)
      ((string-suffix? "fat" type) check-fat-file-system)
+     ((string-prefix? "jfs" type) check-jfs-file-system)
      (else #f)))
 
   (if check-procedure
-- 
2.23.0

[bug#38860] [PATCH 2/7] uuid: Add support for JFS.

[Tobias Geerinckx-Rice via Guix-patches via]

* gnu/system/uuid.scm (string->jfs-uuid): New procedure.
(%uuid-parsers, %uuid-printers): Add ‘jfs’ file system type.
---
 gnu/system/uuid.scm | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index e7a3a0439d..225959e2b7 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,6 +44,7 @@
             string->ext4-uuid
             string->btrfs-uuid
             string->fat-uuid
+            string->jfs-uuid
             iso9660-uuid->string
 
             ;; XXX: For lack of a better place.
@@ -202,6 +204,7 @@ ISO9660 UUID representation."
 (define string->ext3-uuid string->dce-uuid)
 (define string->ext4-uuid string->dce-uuid)
 (define string->btrfs-uuid string->dce-uuid)
+(define string->jfs-uuid string->dce-uuid)
 
 (define-syntax vhashq
   (syntax-rules (=>)
@@ -215,13 +218,13 @@ ISO9660 UUID representation."
 
 (define %uuid-parsers
   (vhashq
-   ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid)
+   ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => string->dce-uuid)
    ('fat32 'fat16 'fat => string->fat-uuid)
    ('iso9660 => string->iso9660-uuid)))
 
 (define %uuid-printers
   (vhashq
-   ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => dce-uuid->string)
+   ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => dce-uuid->string)
    ('iso9660 => iso9660-uuid->string)
    ('fat32 'fat16 'fat => fat-uuid->string)))
 
-- 
2.23.0

[bug#38860] [PATCH 3/7] gnu: Add jfsutils-static.

[Tobias Geerinckx-Rice via Guix-patches via]

gnu/packages/file-systems.scm (jfsutils/static): New public variable.
---
 gnu/packages/file-systems.scm | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/gnu/packages/file-systems.scm b/gnu/packages/file-systems.scm
index fbf0e2641f..3a8848b3ad 100644
--- a/gnu/packages/file-systems.scm
+++ b/gnu/packages/file-systems.scm
@@ -145,6 +145,15 @@ transaction log.
 @end enumerate\n")
     (license license:gpl3+)))          ; no explicit version given
 
+(define-public jfsutils/static
+  (static-package
+   (package
+     (inherit jfsutils)
+     (name "jfsutils-static")
+     (inputs
+      `(("util-linux:static" ,util-linux "static")
+        ,@(package-inputs jfsutils))))))
+
 (define-public disorderfs
   (package
     (name "disorderfs")
-- 
2.23.0

[bug#38860] [PATCH 4/7] gnu: Add jfs_fsck-static.

[Tobias Geerinckx-Rice via Guix-patches via]

* gnu/packages/file-systems.scm (jfs_fsck-static): New public variable.
---
 gnu/packages/file-systems.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/gnu/packages/file-systems.scm b/gnu/packages/file-systems.scm
index 3a8848b3ad..a3dc993055 100644
--- a/gnu/packages/file-systems.scm
+++ b/gnu/packages/file-systems.scm
@@ -28,6 +28,7 @@
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system linux-module)
+  #:use-module (guix build-system trivial)
   #:use-module (guix utils)
   #:use-module (gnu packages)
   #:use-module (gnu packages acl)
@@ -154,6 +155,38 @@ transaction log.
       `(("util-linux:static" ,util-linux "static")
         ,@(package-inputs jfsutils))))))
 
+(define-public jfs_fsck/static
+  (package
+    (name "jfs_fsck-static")
+    (version (package-version jfsutils))
+    (source #f)
+    (build-system trivial-build-system)
+    (arguments
+     `(#:modules ((guix build utils))
+       #:builder
+       (begin
+         (use-modules (guix build utils)
+                      (ice-9 ftw)
+                      (srfi srfi-26))
+         (let* ((jfsutils (assoc-ref %build-inputs "jfsutils"))
+                (fsck     "jfs_fsck")
+                (out      (assoc-ref %outputs "out"))
+                (sbin     (string-append out "/sbin")))
+           (mkdir-p sbin)
+           (with-directory-excursion sbin
+             (install-file (string-append jfsutils "/sbin/" fsck)
+                           ".")
+             (remove-store-references fsck)
+             (chmod fsck #o555))
+           #t))))
+    (inputs
+     `(("jfsutils" ,jfsutils/static)))
+    (home-page (package-home-page jfsutils))
+    (synopsis "Statically-linked jfs_fsck command from jfsutils")
+    (description "This package provides statically-linked jfs_fsck command taken
+from the jfsutils package.  It is meant to be used in initrds.")
+    (license (package-license jfsutils))))
+
 (define-public disorderfs
   (package
     (name "disorderfs")
-- 
2.23.0

[bug#38860] [PATCH 5/7] linux-initrd: Add support for JFS.

[Tobias Geerinckx-Rice via Guix-patches via]

* gnu/system/linux-initrd.scm (file-system-packages): Add jfs_fsck/static.
(file-system-type-modules): Add ‘jfs’ module.
---
 gnu/system/linux-initrd.scm | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 0efb8fb222..dcc9b6b937 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +31,7 @@
   #:use-module (gnu packages compression)
   #:use-module (gnu packages disk)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages file-systems)
   #:use-module (gnu packages guile)
   #:use-module ((gnu packages xorg)
                 #:select (console-setup xkeyboard-config))
@@ -240,6 +242,9 @@ FILE-SYSTEMS."
           '())
     ,@(if (find (file-system-type-predicate "btrfs") file-systems)
           (list btrfs-progs/static)
+          '())
+    ,@(if (find (file-system-type-predicate "jfs") file-systems)
+          (list jfs_fsck/static)
           '())))
 
 (define-syntax vhash                              ;TODO: factorize
@@ -269,6 +274,7 @@ FILE-SYSTEMS."
                     ("9p" => '("9p" "9pnet_virtio"))
                     ("btrfs" => '("btrfs"))
                     ("iso9660" => '("isofs"))
+                    ("jfs" => '("jfs"))
                     (else '())))
 
 (define (file-system-modules file-systems)
-- 
2.23.0

[bug#38860] [PATCH 6/7] tests: install: Test a JFS root file system.

[Tobias Geerinckx-Rice via Guix-patches via]

* gnu/tests/install.scm (%jfs-root-os, %jfs-root-installation-script)
(%test-jfs-root-os): New variables.
---
 gnu/tests/install.scm | 78 +++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 76 insertions(+), 2 deletions(-)

diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index bce4c4b9d4..8842d48df8 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,7 +43,8 @@
             %test-separate-home-os
             %test-raid-root-os
             %test-encrypted-root-os
-            %test-btrfs-root-os))
+            %test-btrfs-root-os
+            %test-jfs-root-os))
 
 ;;; Commentary:
 ;;;
@@ -810,4 +811,77 @@ build (current-guix) and then store a couple of full system images.")
                          (command (qemu-command/writable-image image)))
       (run-basic-test %btrfs-root-os command "btrfs-root-os")))))
 
+\f
+;;;
+;;; JFS root file system.
+;;;
+
+(define-os-with-source (%jfs-root-os %jfs-root-os-source)
+  ;; The OS we want to install.
+  (use-modules (gnu) (gnu tests) (srfi srfi-1))
+
+  (operating-system
+    (host-name "liberigilo")
+    (timezone "Europe/Paris")
+    (locale "en_US.UTF-8")
+
+    (bootloader (bootloader-configuration
+                 (bootloader grub-bootloader)
+                 (target "/dev/vdb")))
+    (kernel-arguments '("console=ttyS0"))
+    (file-systems (cons (file-system
+                          (device (file-system-label "my-root"))
+                          (mount-point "/")
+                          (type "jfs"))
+                        %base-file-systems))
+    (users (cons (user-account
+                  (name "charlie")
+                  (group "users")
+                  (supplementary-groups '("wheel" "audio" "video")))
+                 %base-user-accounts))
+    (services (cons (service marionette-service-type
+                             (marionette-configuration
+                              (imported-modules '((gnu services herd)
+                                                  (guix combinators)))))
+                    %base-services))))
+
+(define %jfs-root-installation-script
+  ;; Shell script of a simple installation.
+  "\
+. /etc/profile
+set -e -x
+guix --version
+
+export GUIX_BUILD_OPTIONS=--no-grafts
+ls -l /run/current-system/gc-roots
+parted --script /dev/vdb mklabel gpt \\
+  mkpart primary ext2 1M 3M \\
+  mkpart primary ext2 3M 2G \\
+  set 1 boot on \\
+  set 1 bios_grub on
+jfs_mkfs -L my-root -q /dev/vdb2
+mount /dev/vdb2 /mnt
+herd start cow-store /mnt
+mkdir /mnt/etc
+cp /etc/target-config.scm /mnt/etc/config.scm
+guix system build /mnt/etc/config.scm
+guix system init /mnt/etc/config.scm /mnt --no-substitutes
+sync
+reboot\n")
+
+(define %test-jfs-root-os
+  (system-test
+   (name "jfs-root-os")
+   (description
+    "Test basic functionality of an OS installed like one would do by hand.
+This test is expensive in terms of CPU and storage usage since we need to
+build (current-guix) and then store a couple of full system images.")
+   (value
+    (mlet* %store-monad ((image   (run-install %jfs-root-os
+                                               %jfs-root-os-source
+                                               #:script
+                                               %jfs-root-installation-script))
+                         (command (qemu-command/writable-image image)))
+      (run-basic-test %jfs-root-os command "jfs-root-os")))))
+
 ;;; install.scm ends here
-- 
2.23.0

[bug#38860] [PATCH 7/7] install: Add jfsutils to the installation image.

[Tobias Geerinckx-Rice via Guix-patches via]

* gnu/system/install.scm (installation-os)[packages]: Add jfsutils.
---
 gnu/system/install.scm | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 4d1612ac7f..c15c2c7814 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
-;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +38,7 @@
   #:use-module (gnu packages bash)
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages certs)
+  #:use-module (gnu packages file-systems)
   #:use-module (gnu packages fonts)
   #:use-module (gnu packages fontutils)
   #:use-module (gnu packages guile)
@@ -488,6 +489,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
                      mdadm
                      dosfstools         ;mkfs.fat, for the UEFI boot partition
                      btrfs-progs
+                     jfsutils
                      openssh    ;we already have sshd, having ssh/scp can help
                      wireless-tools iw wpa-supplicant-minimal iproute
                      ;; XXX: We used to have GNU fdisk here, but as of version
-- 
2.23.0

[bug#38860] Support JFS!

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 56 bytes --]

Hi,

I reviewed and tested the patchset and it LGTM!

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

bug#38860: Support JFS!

[Tobias Geerinckx-Rice via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 201 bytes --]

Danny,

Danny Milosavljevic 写道：
> I reviewed and tested the patchset and it LGTM!

Thank you very much!

Pushed as b24f561c5efc6cd5afb7afa9d8cf7a1e32dfbb35 &al.

Kind regards,

T G-R

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]