[PATCH] file-systems: Add record type <nfs-share> for a file system device.

OpenSubmitted by Stefan.
Details
3 participants
  • Danny Milosavljevic
  • Mathieu Othacehe
  • Stefan
Owner
unassigned
Severity
normal
S
S
Stefan wrote on 12 Jun 2020 01:37
(address . guix-patches@gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
E27E841A-D3EB-472A-911C-D92CE0224B44@vodafonemail.de
* doc/guix.texi: Add description for 'nfs-share'.
* gnu/bootloader/grub.scm (grub-root-search): Support 'nfs-share'.
* gnu/build/file-systems.scm (canonicalize-device-spec): Support 'nfs-share'.
* gnu/build/linux-boot.scm (device-string->file-system-device): Support
'nfs-share'.
* gnu/machine/ssh.scm (machine-check-file-system-availability): Support
'nfs-share'.
* gnu/services/base.scm (file-system->fstab-entry): Support 'nfs-share'.
* gnu/system.scm (read-boot-parameters, device-sexp->device, device->sexp):
Support 'nfs-share'.
* gnu/system/file-systems.scm (<nfs-share>): New record type with printer.
(nfs-share): New function to conditionally construct an 'nfs-share' record.
(nfs-share->string): New function.
(nfs-share?): New predicate.
(file-system-device->string, file-system->spec, spec->file-system): Support
'nfs-share'.
* guix/scripts/system.scm (display-system-generation, check-initrd-modules):
Support 'nfs-share'.
---
doc/guix.texi | 38 ++++++++++++++++++++++++++++++-------
gnu/bootloader.scm | 4 ++--
gnu/bootloader/grub.scm | 2 ++
gnu/build/file-systems.scm | 12 ++++++------
gnu/build/linux-boot.scm | 7 ++++---
gnu/machine/ssh.scm | 23 ++++++++++++++++++++++
gnu/services/base.scm | 2 ++
gnu/system.scm | 4 ++++
gnu/system/file-systems.scm | 36 +++++++++++++++++++++++++++++++++--
guix/scripts/system.scm | 9 +++++++--
10 files changed, 115 insertions(+), 22 deletions(-)

Toggle diff (345 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 15e077a41c..4fd3793a4f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11723,10 +11723,10 @@ This is a string specifying the type of the file system---e.g.,
 This designates the place where the file system is to be mounted.
 
 @item @code{device}
-This names the ``source'' of the file system.  It can be one of three
-things: a file system label, a file system UUID, or the name of a
-@file{/dev} node.  Labels and UUIDs offer a way to refer to file
-systems without having to hard-code their actual device
+This names the ``source'' of the file system.  It can be one of four
+things: a file system label, a file system UUID, the name of a
+@file{/dev} node, or an NFS share.  Labels and UUIDs offer a way to
+refer to file systems without having to hard-code their actual device
 name@footnote{Note that, while it is tempting to use
 @file{/dev/disk/by-uuid} and similar device names to achieve the same
 result, this is not recommended: These special device nodes are created
@@ -11735,9 +11735,10 @@ mounted.}.
 
 @findex file-system-label
 File system labels are created using the @code{file-system-label}
-procedure, UUIDs are created using @code{uuid}, and @file{/dev} node are
-plain strings.  Here's an example of a file system referred to by its
-label, as shown by the @command{e2label} command:
+procedure, UUIDs are created using @code{uuid}, NFS shares are created
+using @code{nfs-share}, and @file{/dev} nodes are plain strings.  Here's
+an example of a file system referred to by its label, as shown by the
+@command{e2label} command:
 
 @lisp
 (file-system
@@ -11762,6 +11763,29 @@ like this:
   (device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
 @end lisp
 
+@findex nfs-share
+An NFS share is defined in one of the following ways. Please note that
+the NFS server for a root file system needs to be passed as IP address
+via the @code{options} field as @code{"addr="} option.
+
+@lisp
+(file-system
+  (mount-point "/")
+  (type "nfs")
+  (device (nfs-share ":/srv/nfs/guix-root"))
+  (options "addr=10.10.10.10,vers=4.1")
+  (needed-for-boot? #t))
+@end lisp
+
+@lisp
+(file-system
+  (mount-point "/music")
+  (type "nfs")
+  (device (nfs-share "music-server.local:/srv/nfs/music"))
+  (options "vers=4.1")
+  (needed-for-boot? #f))
+@end lisp
+
 When the source of a file system is a mapped device (@pxref{Mapped
 Devices}), its @code{device} field @emph{must} refer to the mapped
 device name---e.g., @file{"/dev/mapper/root-partition"}.
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2eebb8e9d9..62c585670b 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -77,8 +77,8 @@
   menu-entry make-menu-entry
   menu-entry?
   (label           menu-entry-label)
-  (device          menu-entry-device       ; file system uuid, label, or #f
-                   (default #f))
+  (device          menu-entry-device       ; uuid, file-system-label,
+                   (default #f))           ; nfs-share, or #f
   (device-mount-point menu-entry-device-mount-point
                    (default #f))
   (linux           menu-entry-linux
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index b905ae360c..d82c09a79d 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -295,6 +295,8 @@ code."
         ((? file-system-label? label)
          (format #f "search --label --set ~a"
                  (file-system-label->string label)))
+        ((? nfs-share?)
+         "set root=(tftp)")
         ((or #f (? string?))
          #~(format #f "search --file --set ~a" #$file)))))
 
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index ad92d8a496..306cff75fb 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -636,8 +636,8 @@ were found."
 
 ^L
 (define (canonicalize-device-spec spec)
-  "Return the device name corresponding to SPEC, which can be a <uuid>, a
-<file-system-label>, or a string (typically a /dev file name)."
+  "Return the device name corresponding to SPEC, which can be a <uuid>, an
+<nfs-share>, a <file-system-label>, or a string (typically a /dev file name)."
   (define max-trials
     ;; Number of times we retry partition label resolution, 1 second per
     ;; trial.  Note: somebody reported a delay of 16 seconds (!) before their
@@ -661,10 +661,10 @@ were found."
 
   (match spec
     ((? string?)
-     (if (string-contains spec ":/")
-         spec                  ; do not resolve NFS devices
-         ;; Nothing to do, but wait until SPEC shows up.
-         (resolve identity spec identity)))
+     ;; Nothing to do, but wait until SPEC shows up.
+     (resolve identity spec identity))
+    ((? nfs-share?)
+     (nfs-share->string spec))
     ((? file-system-label?)
      ;; Resolve the label.
      (resolve find-partition-by-label
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 80fe0cfb9d..8a609f6eff 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -469,10 +469,11 @@ upon error."
 
   (define (device-string->file-system-device device-string)
     ;; The "--root=SPEC" kernel command-line option always provides a
-    ;; string, but the string can represent a device, a UUID, or a
-    ;; label.  So check for all three.
-    (cond ((string-prefix? "/" device-string) device-string)
+    ;; string, but the string can represent a device, a UUID, an nfs-share,
+    ;; or a label.  So check for all of theme.
+    (cond ((nfs-share device-string #:on-error (const #f)) => identity)
           ((uuid device-string) => identity)
+          ((string-prefix? "/" device-string) device-string)
           (else (file-system-label device-string))))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 116da86327..aa42a082c2 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -222,6 +222,24 @@ exist on the machine."
                  (message (format #f (G_ "no file system with UUID '~a'")
                                   (uuid->string (file-system-device fs))))))))))
 
+  (define (check-nfs-share fs)
+    (define remote-exp
+      (with-imported-modules (source-module-closure
+                              '((gnu build file-systems)))
+        #~(begin
+            (use-modules (gnu build file-systems))
+
+            ;; TODO: Try to mount the share or to ping the server.
+            (nfs-share->string (nfs-share
+                                 #$(nfs-share->string (file-system-device fs)))))))
+
+    (remote-let ((result remote-exp))
+      (unless result
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "no nfs-share '~a'")
+                                  (nfs-share->string (file-system-device fs))))))))))
+
   (append (map check-literal-file-system
                (filter (lambda (fs)
                          (string? (file-system-device fs)))
@@ -233,6 +251,10 @@ exist on the machine."
           (map check-uuid-file-system
                (filter (lambda (fs)
                          (uuid? (file-system-device fs)))
+                       file-systems))
+          (map check-nfs-share
+               (filter (lambda (fs)
+                         (nfs-share? (file-system-device fs)))
                        file-systems))))
 
 (define (machine-check-initrd-modules machine)
@@ -257,6 +279,7 @@ not available in the initrd."
 
               (define dev
                 #$(cond ((string? device) device)
+                        ((nfs-share? device) (nfs-share->string device))
                         ((uuid? device) #~(find-partition-by-uuid
                                            (string->uuid
                                             #$(uuid->string device))))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 6ea7ef8e7e..beef30fdf4 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -200,6 +200,8 @@
                                    (file-system-label->string label)))
                    ((? uuid? uuid)
                     (string-append "UUID=" (uuid->string uuid)))
+                   ((? nfs-share? share)
+                    (nfs-share->string share))
                    ((? string? device)
                     device))
                  "\t"
diff --git a/gnu/system.scm b/gnu/system.scm
index d51691fe76..660255b9e9 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -306,6 +306,8 @@ file system labels."
        (bytevector->uuid bv type))
       (('file-system-label (? string? label))
        (file-system-label label))
+      (('nfs-share (? string? share))
+       (nfs-share share))
       ((? bytevector? bv)                         ;old format
        (bytevector->uuid bv 'dce))
       ((? string? device)
@@ -1240,6 +1242,8 @@ such as '--root' and '--load' to <boot-parameters>."
      `(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
     ((? file-system-label? label)
      `(file-system-label ,(file-system-label->string label)))
+    ((? nfs-share? share)
+     `(nfs-share ,(nfs-share->string share)))
     (_
      device)))
 
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 0f94577760..13ef38e490 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -59,6 +59,10 @@
             file-system-label?
             file-system-label->string
 
+            nfs-share
+            nfs-share?
+            nfs-share->string
+
             file-system->spec
             spec->file-system
             specification->file-system-mapping
@@ -102,7 +106,8 @@
 (define-record-type* <file-system> %file-system
   make-file-system
   file-system?
-  (device           file-system-device) ; string | <uuid> | <file-system-label>
+  (device           file-system-device) ; <uuid> | <file-system-label>
+                                        ; <nfs-share> | string
   (mount-point      file-system-mount-point)      ; string
   (type             file-system-type)             ; string
   (flags            file-system-flags             ; list of symbols
@@ -134,6 +139,27 @@
                             (format port "#<file-system-label ~s>"
                                     (file-system-label->string obj))))
 
+;; An nfs-share for use in the 'device' field.
+(define-record-type <nfs-share>
+  (make-nfs-share share)
+  nfs-share?
+  (share nfs-share->string))
+
+(define* (nfs-share share #:key (on-error
+                                  (lambda (share)
+                                    (error "The nfs-share is missing \":/\" in"
+                                           share))))
+  "Try to construct an nfs-share, return (on-errer share) if share is invalid.
+Use #:on-error (const #f)' to check validity and avoid an error to be thrown."
+  (if (string-contains share ":/")
+      (make-nfs-share share)
+      (on-error share)))
+
+(set-record-type-printer! <nfs-share>
+                          (lambda (obj port)
+                            (format port "#<nfs-share ~s>"
+                                    (nfs-share->string obj))))
+
 (define-syntax report-deprecation
   (lambda (s)
     "Report the use of the now-deprecated 'title' field."
@@ -149,7 +175,7 @@
                  file line column)
          #t)))))
 
-;; Helper for 'process-file-system-declaration'.
+;; Helper for the deprecated 'process-file-system-declaration'.
 (define-syntax device-expression
   (syntax-rules (quote label uuid device)
     ((_ (quote label) dev)
@@ -257,6 +283,8 @@ UUID-TYPE, a symbol such as 'dce or 'iso9660."
      (if uuid-type
          (uuid->string (uuid-bytevector device) uuid-type)
          (uuid->string device)))
+    ((? nfs-share?)
+     (nfs-share->string device))
     ((? string?)
      device)))
 
@@ -303,6 +331,8 @@ initrd code."
                   `(uuid ,(uuid-type device) ,(uuid-bytevector device)))
                  ((file-system-label? device)
                   `(file-system-label ,(file-system-label->string device)))
+                 ((nfs-share? device)
+                  `(nfs-share ,(nfs-share->string device)))
                  (else device))
            mount-point type flags options check?))))
 
@@ -316,6 +346,8 @@ initrd code."
                   (bytevector->uuid bv type))
                  (('file-system-label (? string? label))
                   (file-system-label label))
+                 (('nfs-share (? string? share))
+                  (nfs-share share))
                  (_
                   device)))
        (mount-point mount-point) (type type)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3d7aa77cb7..27b324deac 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -497,12 +497,15 @@ list of services."
       ;;   root device: UUID: 12345-678
       ;; or:
       ;;   root device: label: "my-root"
+      ;; or:
+      ;;  root device: nfs-share: 0.0.0.0:/my-root
       ;; or just:
       ;;   root device: /dev/sda3
-      (format #t (G_ "  root device: ~[UUID: ~a~;label: ~s~;~a~]~%")
+      (format #t (G_ "  root device: ~[UUID: ~a~;label: ~s~;nfs-share: ~a~;~a~]~%")
               (cond ((uuid? root-device) 0)
                     ((file-system-label? root-device) 1)
-                    (else 2))
+                    ((nfs-share? root-device) 2)
+                    (else 3))
               (file-system-device->string root-device))
 
       (format #t (G_ "  kernel: ~a~%") kernel)
@@ -649,6 +652,8 @@ checking this by themselves in their 'check' procedure."
       (match device
         ((? string?)
          device)
+        ((? nfs-share?)
+         (nfs-share->string device))
         ((? uuid?)
          (find-partition-by-uuid device))
         ((? file-system-label?)
-- 
2.26.0
S
S
Stefan wrote on 12 Jun 2020 01:43
(address . 41820@debbugs.gnu.org)
BF3FCAF4-4B69-41AF-8B41-C82EBDC1CACE@vodafonemail.de
Hi!

Now that the new record <nfs-share> is working and seeing the amount of changes to make this working, I get the impression that this is unnecessarily complicated.

In the end there will be the "--root=" option for the kernel, which is only a plain string. And most of the device record related functions in the end target to produce a string.

And then there is (device-string->file-system-device) in gnu/build/linux-boot.scm to convert this string back into a device record.

As long as this conversion to and from string is necessary, there is no real benefit in having different record types for (file-system (device …)), it could just be a string. Then there would only be the need for a simple parser function like (device-string->device-type) to determine the type of device to be used in places where the type matters.


Bye

Stefan
S
S
Stefan wrote on 20 Jun 2020 15:52
(address . 41820@debbugs.gnu.org)
3E9A3851-44B1-4062-A4ED-983BB0114D5D@vodafonemail.de
Hi!

A friendly ping.

What about this patch? This is what has been requested. Can it be pushed or does someone have further requests?


Bye

Stefan
M
M
Mathieu Othacehe wrote on 21 Jun 2020 11:35
(name . Stefan)(address . stefan-guix@vodafonemail.de)
87tuz44v7k.fsf@gnu.org
Hello Stefan,

Thanks a lot for this patch, overall it look nice! Without going into
details here are a few remarks:

* As you probably noticed the bootloading & system part of Guix is
moving a lot recently. This patch does not apply on master, so it would
be nice if you could rebase it and pass "--base=auto" option to "git
format-patch" so that it's easier to apply it.

* It would be nice to have tests for this functionality. There's already
a (gnu tests nfs) module, testing the NFS service. Maybe you could add a
test case of a marionette booting from a local NFS share.

* Finally, now that file-system "device" field can be a label, a UUID, a
"/dev" node and an "nfs-share", it makes me think that we could need a
new layer of abstraction here, but this can come later and I need to
think more about it.

Thanks,

Mathieu
S
S
Stefan wrote on 1 Jul 2020 20:48
(name . Mathieu Othacehe)(address . othacehe@gnu.org)
39F7973C-8A64-4B6D-9A26-D98AA7F37475@vodafonemail.de
Hi Mathieu!

Toggle quote (5 lines)
> * As you probably noticed the bootloading & system part of Guix is
> moving a lot recently. This patch does not apply on master, so it would
> be nice if you could rebase it and pass "--base=auto" option to "git
> format-patch" so that it's easier to apply it.

OK.

Toggle quote (4 lines)
> * It would be nice to have tests for this functionality. There's already
> a (gnu tests nfs) module, testing the NFS service. Maybe you could add a
> test case of a marionette booting from a local NFS share.

I tried. Unfortunately on my little aarch64 SBC compiling the necessary packages takes days – there are no substitutes available – and in the end qemu-5 has a failing test. I retried and rebased and retried and wasted days in the end. I’m a bit frustrated. :-(

TEST iotest-qcow2: 244 [fail]
QEMU -- "/tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/../../aarch64-softmmu/qemu-system-aarch64" -nodefaults -display none -machine
virt -accel qtest
QEMU_IMG -- "/tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/../../qemu-img"
QEMU_IO -- "/tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/../../qemu-io" --cache writeback --aio threads -f qcow2
QEMU_NBD -- "/tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/../../qemu-nbd"
IMGFMT -- qcow2 (compat=1.1)
IMGPROTO -- file
PLATFORM -- Linux/aarch64 5.5.9
TEST_DIR -- /tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/scratch
SOCK_DIR -- /tmp/guix-build-qemu-5.0.0.drv-0/tmp.qUme9gv2Jy
SOCKET_SCM_HELPER -- /tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/socket_scm_helper

--- /tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/244.out 2020-04-28 16:49:25.000000000 +0000
+++ /tmp/guix-build-qemu-5.0.0.drv-0/qemu-5.0.0/tests/qemu-iotests/244.out.bad 2020-06-29 10:27:02.036147483 +0000
@@ -74,6 +74,7 @@
1 MiB, X ops; XX:XX:XX.X (XXX YYY/sec and XXX ops/sec)
read 1048576/1048576 bytes at offset 1048576
1 MiB, X ops; XX:XX:XX.X (XXX YYY/sec and XXX ops/sec)
+Pattern verification failed at offset 2097152, 2097152 bytes
read 2097152/2097152 bytes at offset 2097152
2 MiB, X ops; XX:XX:XX.X (XXX YYY/sec and XXX ops/sec)
read 1048576/1048576 bytes at offset 4194304
@@ -108,7 +109,7 @@
read 4194304/4194304 bytes at offset 2097152
4 MiB, X ops; XX:XX:XX.X (XXX YYY/sec and XXX ops/sec)

-Images are identical.
+Content mismatch at offset 2097152!
qcow2 file size after I/O: 327680

=== bdrv_co_block_status test for file and offset=0 ===



This is the test that I wrote and wanted to try. Maybe you can pick it up and give it a try.


(define (run-nfs-root-fs-test)
"Run a test of an OS mounting its root file system via NFS."
(define nfs-root-server-os
(marionette-operating-system
(operating-system
(inherit %nfs-os)
(file-systems %base-file-systems)
(services
(modify-services (operating-system-user-services %nfs-os)
(nfs-service-type
config
=>
(nfs-configuration
(debug '(nfs nfsd mountd))
(exports '(("/export"
"*(rw,insecure,no_subtree_check,crossmnt,fsid=root,no_root_squash,insecure,async)"))))))))
#:requirements '(nscd)
#:imported-modules '((gnu services herd)
(guix combinators))))

(define nfs-root-client-os
(marionette-operating-system
(operating-system
(inherit %nfs-os)
(kernel-arguments '("ip=dhcp"))
(file-systems (cons
(file-system
(type "nfs")
(mount-point "/")
(device (nfs-share ":/export"))
(options "addr=0.0.0.0,vers=4.2"))
%base-file-systems)))
#:requirements '(nscd)
#:imported-modules '((gnu services herd)
(guix combinators))))

(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64))

(define server-marionette
(make-marionette (list #$(virtual-machine nfs-root-server-os))))
(define client-marionette
(make-marionette (list #$(virtual-machine nfs-root-client-os))))

(mkdir #$output)
(chdir #$output)

(test-begin "start-nfs-root-server")
(marionette-eval
'(begin
(use-modules (gnu services herd))

(current-output-port
(open-file "/dev/console" "w0"))
(chmod "/export" #o777)
(symlink "/gnu" "/export/gnu")
(start-service 'nscd))
(start-service 'networking)
(start-service 'nfs)
server-marionette)

;; Wait for the NFS services to be up and running.
(test-assert "nfs services are running"
(wait-for-file "/var/run/rpc.statd.pid" server-marionette))

(test-begin "boot-nfs-root-client")
(marionette-eval
'(begin
(use-modules (gnu services herd))

(current-output-port
(open-file "/dev/console" "w0"))
(with-output-to-file "/var/run/mounts"
(lambda () (system* "mount")))
(chmod "/var/run/mounts" #o777))
client-marionette)

(test-assert "nfs-root-client booted")
(marionelle-eval
'(begin
(and (file-exists? "/export/var/run/mounts")
(system* "cat" "/export/var/run/mounts")))
server-marionette)

(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))

(gexp->derivation "nfs-server-test" test))

(define %test-nfs-root-fs
(system-test
(name "nfs-root-fs")
(description "Test that an NFS server can be started and exported
directories can be mounted.")
(value (run-nfs-root-fs-test))))


Bye

Stefan
S
S
Stefan wrote on 1 Jul 2020 20:48
(name . Mathieu Othacehe)(address . othacehe@gnu.org)
ED6CDFDF-A011-47CE-B506-C822F9D3EA40@vodafonemail.de
* doc/guix.texi: Add description for 'nfs-share'.
* gnu/bootloader/grub.scm (grub-root-search): Support 'nfs-share'.
* gnu/build/file-systems.scm (canonicalize-device-spec): Support 'nfs-share'.
* gnu/build/linux-boot.scm (device-string->file-system-device): Support
'nfs-share'.
* gnu/machine/ssh.scm (machine-check-file-system-availability): Support
'nfs-share'.
* gnu/services/base.scm (file-system->fstab-entry): Support 'nfs-share'.
* gnu/system.scm (read-boot-parameters, device-sexp->device, device->sexp):
Support 'nfs-share'.
* gnu/system/file-systems.scm (<nfs-share>): New record type with printer.
(nfs-share): New function to conditionally construct an 'nfs-share' record.
(nfs-share->string): New function.
(nfs-share?): New predicate.
(file-system-device->string, file-system->spec, spec->file-system): Support
'nfs-share'.
* guix/scripts/system.scm (display-system-generation, check-initrd-modules):
Support 'nfs-share'.
---
doc/guix.texi | 38 ++++++++++++++++++++++++++++++-------
gnu/bootloader.scm | 4 ++--
gnu/bootloader/grub.scm | 2 ++
gnu/build/file-systems.scm | 12 ++++++------
gnu/build/linux-boot.scm | 7 ++++---
gnu/machine/ssh.scm | 23 ++++++++++++++++++++++
gnu/services/base.scm | 2 ++
gnu/system.scm | 4 ++++
gnu/system/file-systems.scm | 36 +++++++++++++++++++++++++++++++++--
guix/scripts/system.scm | 9 +++++++--
10 files changed, 115 insertions(+), 22 deletions(-)

Toggle diff (347 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 15e077a41c..4fd3793a4f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11723,10 +11723,10 @@ This is a string specifying the type of the file system---e.g.,
 This designates the place where the file system is to be mounted.
 
 @item @code{device}
-This names the ``source'' of the file system.  It can be one of three
-things: a file system label, a file system UUID, or the name of a
-@file{/dev} node.  Labels and UUIDs offer a way to refer to file
-systems without having to hard-code their actual device
+This names the ``source'' of the file system.  It can be one of four
+things: a file system label, a file system UUID, the name of a
+@file{/dev} node, or an NFS share.  Labels and UUIDs offer a way to
+refer to file systems without having to hard-code their actual device
 name@footnote{Note that, while it is tempting to use
 @file{/dev/disk/by-uuid} and similar device names to achieve the same
 result, this is not recommended: These special device nodes are created
@@ -11735,9 +11735,10 @@ mounted.}.
 
 @findex file-system-label
 File system labels are created using the @code{file-system-label}
-procedure, UUIDs are created using @code{uuid}, and @file{/dev} node are
-plain strings.  Here's an example of a file system referred to by its
-label, as shown by the @command{e2label} command:
+procedure, UUIDs are created using @code{uuid}, NFS shares are created
+using @code{nfs-share}, and @file{/dev} nodes are plain strings.  Here's
+an example of a file system referred to by its label, as shown by the
+@command{e2label} command:
 
 @lisp
 (file-system
@@ -11762,6 +11763,29 @@ like this:
   (device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
 @end lisp
 
+@findex nfs-share
+An NFS share is defined in one of the following ways. Please note that
+the NFS server for a root file system needs to be passed as IP address
+via the @code{options} field as @code{"addr="} option.
+
+@lisp
+(file-system
+  (mount-point "/")
+  (type "nfs")
+  (device (nfs-share ":/srv/nfs/guix-root"))
+  (options "addr=10.10.10.10,vers=4.1")
+  (needed-for-boot? #t))
+@end lisp
+
+@lisp
+(file-system
+  (mount-point "/music")
+  (type "nfs")
+  (device (nfs-share "music-server.local:/srv/nfs/music"))
+  (options "vers=4.1")
+  (needed-for-boot? #f))
+@end lisp
+
 When the source of a file system is a mapped device (@pxref{Mapped
 Devices}), its @code{device} field @emph{must} refer to the mapped
 device name---e.g., @file{"/dev/mapper/root-partition"}.
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2eebb8e9d9..62c585670b 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -77,8 +77,8 @@
   menu-entry make-menu-entry
   menu-entry?
   (label           menu-entry-label)
-  (device          menu-entry-device       ; file system uuid, label, or #f
-                   (default #f))
+  (device          menu-entry-device       ; uuid, file-system-label,
+                   (default #f))           ; nfs-share, or #f
   (device-mount-point menu-entry-device-mount-point
                    (default #f))
   (linux           menu-entry-linux
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index b905ae360c..d82c09a79d 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -295,6 +295,8 @@ code."
         ((? file-system-label? label)
          (format #f "search --label --set ~a"
                  (file-system-label->string label)))
+        ((? nfs-share?)
+         "set root=(tftp)")
         ((or #f (? string?))
          #~(format #f "search --file --set ~a" #$file)))))
 
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index ad92d8a496..306cff75fb 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -636,8 +636,8 @@ were found."
 
 ^L
 (define (canonicalize-device-spec spec)
-  "Return the device name corresponding to SPEC, which can be a <uuid>, a
-<file-system-label>, or a string (typically a /dev file name)."
+  "Return the device name corresponding to SPEC, which can be a <uuid>, an
+<nfs-share>, a <file-system-label>, or a string (typically a /dev file name)."
   (define max-trials
     ;; Number of times we retry partition label resolution, 1 second per
     ;; trial.  Note: somebody reported a delay of 16 seconds (!) before their
@@ -661,10 +661,10 @@ were found."
 
   (match spec
     ((? string?)
-     (if (string-contains spec ":/")
-         spec                  ; do not resolve NFS devices
-         ;; Nothing to do, but wait until SPEC shows up.
-         (resolve identity spec identity)))
+     ;; Nothing to do, but wait until SPEC shows up.
+     (resolve identity spec identity))
+    ((? nfs-share?)
+     (nfs-share->string spec))
     ((? file-system-label?)
      ;; Resolve the label.
      (resolve find-partition-by-label
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 80fe0cfb9d..8a609f6eff 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -469,10 +469,11 @@ upon error."
 
   (define (device-string->file-system-device device-string)
     ;; The "--root=SPEC" kernel command-line option always provides a
-    ;; string, but the string can represent a device, a UUID, or a
-    ;; label.  So check for all three.
-    (cond ((string-prefix? "/" device-string) device-string)
+    ;; string, but the string can represent a device, a UUID, an nfs-share,
+    ;; or a label.  So check for all of theme.
+    (cond ((nfs-share device-string #:on-error (const #f)) => identity)
           ((uuid device-string) => identity)
+          ((string-prefix? "/" device-string) device-string)
           (else (file-system-label device-string))))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 116da86327..aa42a082c2 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -222,6 +222,24 @@ exist on the machine."
                  (message (format #f (G_ "no file system with UUID '~a'")
                                   (uuid->string (file-system-device fs))))))))))
 
+  (define (check-nfs-share fs)
+    (define remote-exp
+      (with-imported-modules (source-module-closure
+                              '((gnu build file-systems)))
+        #~(begin
+            (use-modules (gnu build file-systems))
+
+            ;; TODO: Try to mount the share or to ping the server.
+            (nfs-share->string (nfs-share
+                                 #$(nfs-share->string (file-system-device fs)))))))
+
+    (remote-let ((result remote-exp))
+      (unless result
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "no nfs-share '~a'")
+                                  (nfs-share->string (file-system-device fs))))))))))
+
   (append (map check-literal-file-system
                (filter (lambda (fs)
                          (string? (file-system-device fs)))
@@ -233,6 +251,10 @@ exist on the machine."
           (map check-uuid-file-system
                (filter (lambda (fs)
                          (uuid? (file-system-device fs)))
+                       file-systems))
+          (map check-nfs-share
+               (filter (lambda (fs)
+                         (nfs-share? (file-system-device fs)))
                        file-systems))))
 
 (define (machine-check-initrd-modules machine)
@@ -257,6 +279,7 @@ not available in the initrd."
 
               (define dev
                 #$(cond ((string? device) device)
+                        ((nfs-share? device) (nfs-share->string device))
                         ((uuid? device) #~(find-partition-by-uuid
                                            (string->uuid
                                             #$(uuid->string device))))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 6ea7ef8e7e..beef30fdf4 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -200,6 +200,8 @@
                                    (file-system-label->string label)))
                    ((? uuid? uuid)
                     (string-append "UUID=" (uuid->string uuid)))
+                   ((? nfs-share? share)
+                    (nfs-share->string share))
                    ((? string? device)
                     device))
                  "\t"
diff --git a/gnu/system.scm b/gnu/system.scm
index d51691fe76..660255b9e9 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -306,6 +306,8 @@ file system labels."
        (bytevector->uuid bv type))
       (('file-system-label (? string? label))
        (file-system-label label))
+      (('nfs-share (? string? share))
+       (nfs-share share))
       ((? bytevector? bv)                         ;old format
        (bytevector->uuid bv 'dce))
       ((? string? device)
@@ -1240,6 +1242,8 @@ such as '--root' and '--load' to <boot-parameters>."
      `(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
     ((? file-system-label? label)
      `(file-system-label ,(file-system-label->string label)))
+    ((? nfs-share? share)
+     `(nfs-share ,(nfs-share->string share)))
     (_
      device)))
 
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 0f94577760..13ef38e490 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -59,6 +59,10 @@
             file-system-label?
             file-system-label->string
 
+            nfs-share
+            nfs-share?
+            nfs-share->string
+
             file-system->spec
             spec->file-system
             specification->file-system-mapping
@@ -102,7 +106,8 @@
 (define-record-type* <file-system> %file-system
   make-file-system
   file-system?
-  (device           file-system-device) ; string | <uuid> | <file-system-label>
+  (device           file-system-device) ; <uuid> | <file-system-label>
+                                        ; <nfs-share> | string
   (mount-point      file-system-mount-point)      ; string
   (type             file-system-type)             ; string
   (flags            file-system-flags             ; list of symbols
@@ -134,6 +139,27 @@
                             (format port "#<file-system-label ~s>"
                                     (file-system-label->string obj))))
 
+;; An nfs-share for use in the 'device' field.
+(define-record-type <nfs-share>
+  (make-nfs-share share)
+  nfs-share?
+  (share nfs-share->string))
+
+(define* (nfs-share share #:key (on-error
+                                  (lambda (share)
+                                    (error "The nfs-share is missing \":/\" in"
+                                           share))))
+  "Try to construct an nfs-share, return (on-errer share) if share is invalid.
+Use #:on-error (const #f)' to check validity and avoid an error to be thrown."
+  (if (string-contains share ":/")
+      (make-nfs-share share)
+      (on-error share)))
+
+(set-record-type-printer! <nfs-share>
+                          (lambda (obj port)
+                            (format port "#<nfs-share ~s>"
+                                    (nfs-share->string obj))))
+
 (define-syntax report-deprecation
   (lambda (s)
     "Report the use of the now-deprecated 'title' field."
@@ -149,7 +175,7 @@
                  file line column)
          #t)))))
 
-;; Helper for 'process-file-system-declaration'.
+;; Helper for the deprecated 'process-file-system-declaration'.
 (define-syntax device-expression
   (syntax-rules (quote label uuid device)
     ((_ (quote label) dev)
@@ -257,6 +283,8 @@ UUID-TYPE, a symbol such as 'dce or 'iso9660."
      (if uuid-type
          (uuid->string (uuid-bytevector device) uuid-type)
          (uuid->string device)))
+    ((? nfs-share?)
+     (nfs-share->string device))
     ((? string?)
      device)))
 
@@ -303,6 +331,8 @@ initrd code."
                   `(uuid ,(uuid-type device) ,(uuid-bytevector device)))
                  ((file-system-label? device)
                   `(file-system-label ,(file-system-label->string device)))
+                 ((nfs-share? device)
+                  `(nfs-share ,(nfs-share->string device)))
                  (else device))
            mount-point type flags options check?))))
 
@@ -316,6 +346,8 @@ initrd code."
                   (bytevector->uuid bv type))
                  (('file-system-label (? string? label))
                   (file-system-label label))
+                 (('nfs-share (? string? share))
+                  (nfs-share share))
                  (_
                   device)))
        (mount-point mount-point) (type type)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3d7aa77cb7..27b324deac 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -497,12 +497,15 @@ list of services."
       ;;   root device: UUID: 12345-678
       ;; or:
       ;;   root device: label: "my-root"
+      ;; or:
+      ;;  root device: nfs-share: 0.0.0.0:/my-root
       ;; or just:
       ;;   root device: /dev/sda3
-      (format #t (G_ "  root device: ~[UUID: ~a~;label: ~s~;~a~]~%")
+      (format #t (G_ "  root device: ~[UUID: ~a~;label: ~s~;nfs-share: ~a~;~a~]~%")
               (cond ((uuid? root-device) 0)
                     ((file-system-label? root-device) 1)
-                    (else 2))
+                    ((nfs-share? root-device) 2)
+                    (else 3))
               (file-system-device->string root-device))
 
       (format #t (G_ "  kernel: ~a~%") kernel)
@@ -649,6 +652,8 @@ checking this by themselves in their 'check' procedure."
       (match device
         ((? string?)
          device)
+        ((? nfs-share?)
+         (nfs-share->string device))
         ((? uuid?)
          (find-partition-by-uuid device))
         ((? file-system-label?)

base-commit: cbd9581acc41cd49eb81c2432452cad4de805cbd
-- 
2.26.0
S
S
Stefan wrote on 18 Jul 2020 15:55
(name . Mathieu Othacehe)(address . othacehe@gnu.org)
8F500F26-7E4B-4FA1-B7E9-009ACE01DD5B@vodafonemail.de
A friendly ping …
D
D
Danny Milosavljevic wrote on 21 Jul 2020 16:33
(name . Stefan)(address . stefan-guix@vodafonemail.de)
20200721153601.0cdd5234@scratchpost.org
Hi Stefan,

just a heads-up, I've forwarded this to Brice Waegeneire, who I think is best
qualified to review and merge your work. He is working on PXE booting,
starting with regular x86_64 machines. So NFS root is totally something he
both needs and can help with.

Myself, I'm quite satisfied with your version, I'd just like there to be some
minimal tests of the functionality and that's pretty much it.

About the <nfs-share> record, if you think it's better without the record, we
can also do without--but I'd like to know Brice's opinion on it.

The idea was to have the record be something like


if we could have used it. We can't use "nfsroot=" directly because we don't
have network drivers built into the kernel and instead use modules for those.
That also means that the initrd modules have to be automatically extended
by network card drivers, I guess.

So the initrd would basically emulate the fields of "nfsroot=" from the link
above.

So it would be <nfs-root> and would have fields like

server-ip
root-dir
nfs-options (a list)

You're right that having a <nfs-share> with just the host and directory does
not make much sense as a record. But we actually need to configure the
machine as a client in the network to be able to reach the nfs server,
right?

I guess we could ignore the problem and have the DHCP server do
it, and I'm all for it--but some use cases might need manual configuration,
too. Even then, is it possible to know which NFS protocol version to use
for the NFS root automatically? Even in your case, you don't actually
get the nfs IP from the DHCP server either, but you make the user pass it
by splicing it to some string, right?

So some kind of <nfs-root-client> or whatever record is necessary, I'd say.

@Brice: ?
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCgAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl8W/J4ACgkQ5xo1VCww
uqWa6Qf/R3I1rySpJy0aMgGAaKFlQKT5sPr1W9LJasI34vXIO3SJcmoKPlYI8X85
2evBxv1ak3aW9tBmML9O5u8gOGXSdjiZMpAAQJSLIYXjkUtGlXl0z2iz15zuLho6
XTjALntDAd+KJvvAlys8aAvRFr8b0//6Y1C/heccgLpWP4W/cq4oFS9bWxl6X+65
oSoo1jhNjwm/S8y1ksm1Q3qhDjcLat9iATVQ6D6rXXRTmiJIlmzB7WVz6D5TvHga
YmP7lAUI9RGQxVL7ojfOpZnUWnl6uetE6nIWxzCEL2Uo8Da6GEJNDbfQ+4v3mL/d
xFGgp3UP1Dz7PQNDyC8/EQ7TZgfcbw==
=5/Xd
-----END PGP SIGNATURE-----


?