(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