From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 11 19:37:24 2020 Received: (at submit) by debbugs.gnu.org; 11 Jun 2020 23:37:24 +0000 Received: from localhost ([127.0.0.1]:38366 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjWl9-0005kl-KK for submit@debbugs.gnu.org; Thu, 11 Jun 2020 19:37:24 -0400 Received: from lists.gnu.org ([209.51.188.17]:48468) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjWl7-0005kd-9U for submit@debbugs.gnu.org; Thu, 11 Jun 2020 19:37:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43316) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jjWl7-0002PO-2E for guix-patches@gnu.org; Thu, 11 Jun 2020 19:37:21 -0400 Received: from vsmx012.vodafonemail.xion.oxcs.net ([153.92.174.90]:9405) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jjWl4-0000lI-A7 for guix-patches@gnu.org; Thu, 11 Jun 2020 19:37:20 -0400 Received: from vsmx004.vodafonemail.xion.oxcs.net (unknown [192.168.75.198]) by mta-8-out.mta.xion.oxcs.net (Postfix) with ESMTP id 7EE00F35139; Thu, 11 Jun 2020 23:37:11 +0000 (UTC) Received: from macbook-pro.kuh-wiese.my-router.de (unknown [145.254.41.74]) by mta-8-out.mta.xion.oxcs.net (Postfix) with ESMTPA id 2081819B4CA; Thu, 11 Jun 2020 23:37:06 +0000 (UTC) From: Stefan Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: quoted-printable Subject: [PATCH] file-systems: Add record type for a file system device. Date: Fri, 12 Jun 2020 01:37:06 +0200 Message-Id: To: guix-patches@gnu.org Mime-Version: 1.0 (Mac OS X Mail 9.3 \(3124\)) X-Mailer: Apple Mail (2.3124) X-VADE-STATUS: LEGIT Received-SPF: pass client-ip=153.92.174.90; envelope-from=stefan-guix@vodafonemail.de; helo=vsmx012.vodafonemail.xion.oxcs.net X-detected-operating-system: by eggs.gnu.org: First seen = 2020/06/11 19:37:11 X-ACL-Warn: Detected OS = Linux 2.2.x-3.x (no timestamps) [generic] X-Spam_score_int: -25 X-Spam_score: -2.6 X-Spam_bar: -- X-Spam_report: (-2.6 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=_AUTOLEARN X-Spam_action: no action X-Spam-Score: -1.3 (-) X-Debbugs-Envelope-To: submit Cc: Danny Milosavljevic X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) * 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 (): 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(-) 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. =20 @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.}. =20 @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: =20 @lisp (file-system @@ -11762,6 +11763,29 @@ like this: (device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))) @end lisp =20 +@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=3D"} option. + +@lisp +(file-system + (mount-point "/") + (type "nfs") + (device (nfs-share ":/srv/nfs/guix-root")) + (options "addr=3D10.10.10.10,vers=3D4.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=3D4.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=3D(tftp)") ((or #f (? string?)) #~(format #f "search --file --set ~a" #$file))))) =20 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." =20 ^L (define (canonicalize-device-spec spec) - "Return the device name corresponding to SPEC, which can be a , = a -, or a string (typically a /dev file name)." + "Return the device name corresponding to SPEC, which can be a , = an +, a , 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." =20 (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." =20 (define (device-string->file-system-device device-string) ;; The "--root=3DSPEC" 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)) =3D> = identity) ((uuid device-string) =3D> identity) + ((string-prefix? "/" device-string) device-string) (else (file-system-label device-string)))) =20 (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)))))))))) =20 + (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)))) =20 (define (machine-check-initrd-modules machine) @@ -257,6 +279,7 @@ not available in the initrd." =20 (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=3D" (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 = ." `(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))) =20 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 =20 + 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 make-file-system file-system? - (device file-system-device) ; string | | = + (device file-system-device) ; | + ; | 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->string obj)))) =20 +;; An nfs-share for use in the 'device' field. +(define-record-type + (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! + (lambda (obj port) + (format port "#" + (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))))) =20 -;; 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))) =20 @@ -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?)))) =20 @@ -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)) =20 (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?) --=20 2.26.0