From patchwork Wed Jul 1 18:48:46 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Stefan X-Patchwork-Id: 22983 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id A48FF27BBE3; Wed, 1 Jul 2020 19:50:08 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id C0C4227BBE1 for ; Wed, 1 Jul 2020 19:50:07 +0100 (BST) Received: from localhost ([::1]:41890 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jqho7-0008Ls-BT for patchwork@mira.cbaines.net; Wed, 01 Jul 2020 14:50:07 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49814) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jqho1-0008Lh-Tb for guix-patches@gnu.org; Wed, 01 Jul 2020 14:50:01 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:42202) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jqho1-000840-Ji for guix-patches@gnu.org; Wed, 01 Jul 2020 14:50:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jqho1-000175-IA for guix-patches@gnu.org; Wed, 01 Jul 2020 14:50:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41820] [PATCH] file-systems: Add record type for a file system device. Resent-From: Stefan Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 01 Jul 2020 18:50:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41820 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Mathieu Othacehe Cc: Danny Milosavljevic , 41820@debbugs.gnu.org Received: via spool by 41820-submit@debbugs.gnu.org id=B41820.15936293464211 (code B ref 41820); Wed, 01 Jul 2020 18:50:01 +0000 Received: (at 41820) by debbugs.gnu.org; 1 Jul 2020 18:49:06 +0000 Received: from localhost ([127.0.0.1]:53748 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jqhn7-00015r-Iw for submit@debbugs.gnu.org; Wed, 01 Jul 2020 14:49:06 -0400 Received: from vsmx011.vodafonemail.xion.oxcs.net ([153.92.174.89]:41511) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jqhn5-00014y-Ol for 41820@debbugs.gnu.org; Wed, 01 Jul 2020 14:49:04 -0400 Received: from vsmx003.vodafonemail.xion.oxcs.net (unknown [192.168.75.197]) by mta-5-out.mta.xion.oxcs.net (Postfix) with ESMTP id 32AFF59D4BC; Wed, 1 Jul 2020 18:48:58 +0000 (UTC) Received: from macbook-pro.kuh-wiese.my-router.de (unknown [145.254.41.123]) by mta-7-out.mta.xion.oxcs.net (Postfix) with ESMTPA id C0C4D539B8B; Wed, 1 Jul 2020 18:48:50 +0000 (UTC) Mime-Version: 1.0 (Mac OS X Mail 9.3 \(3124\)) From: Stefan In-Reply-To: <87tuz44v7k.fsf@gnu.org> Date: Wed, 1 Jul 2020 20:48:46 +0200 Message-Id: References: <87tuz44v7k.fsf@gnu.org> X-Mailer: Apple Mail (2.3124) X-VADE-STATUS: LEGIT X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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(-) base-commit: cbd9581acc41cd49eb81c2432452cad4de805cbd 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 , 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." (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 ." `(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 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)))) +;; 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))))) -;; 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?)