Package: guix-patches;
Reported by: Richard Sent <richard <at> freakingpenguin.com>
Date: Tue, 23 Apr 2024 20:47:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #50 received at 70542 <at> debbugs.gnu.org (full text, mbox):
From: Richard Sent <richard <at> freakingpenguin.com> To: 70542 <at> debbugs.gnu.org Cc: Richard Sent <richard <at> freakingpenguin.com> Subject: [PATCH v2 3/3] file-systems: Add support for mounting CIFS file systems Date: Thu, 25 Apr 2024 00:56:05 -0400
* gnu/build/file-systems (canonicalize-device-name): Do not attempt to resolve
CIFS formatted device specifications.
(mount-file-systems): Add mount-cifs nested function.
* gnu/machine/ssh.scm (machine-check-file-system-availability): Skip checking
for CIFS availability, similar to NFS.
* guix/scripts/system.scm (check-file-system-availability): Likewise.
Change-Id: I182e290eba64bbe5d1332815eb93bb68c01e0c3c
---
gnu/build/file-systems.scm | 45 ++++++++++++++++++++++++++++++++++++--
gnu/machine/ssh.scm | 3 ++-
guix/scripts/system.scm | 3 ++-
3 files changed, 47 insertions(+), 4 deletions(-)
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index e47ac39ab0..ae29b36c4e 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -8,6 +8,7 @@
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust <at> gmail.com>
;;; Copyright © 2024 Nicolas Graves <ngraves <at> ngraves.fr>
+;;; Copyright © 2024 Richard Sent <richard <at> freakingpenguin.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,6 +38,7 @@ (define-module (gnu build file-systems)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 regex)
#:use-module (system foreign)
#:autoload (system repl repl) (start-repl)
#:use-module (srfi srfi-1)
@@ -1047,8 +1049,11 @@ (define (canonicalize-device-spec spec)
(match spec
((? string?)
- (if (or (string-contains spec ":/") (string=? spec "none"))
- spec ; do not resolve NFS / tmpfs devices
+ (if (or (string-contains spec ":/") ;nfs
+ (and (>= (string-length spec) 2)
+ (equal? (string-take spec 2) "//")) ;cifs
+ (string=? spec "none"))
+ spec ; do not resolve NFS / CIFS / tmpfs devices
;; Nothing to do, but wait until SPEC shows up.
(resolve identity spec identity)))
((? file-system-label?)
@@ -1181,6 +1186,40 @@ (define* (mount-file-system fs #:key (root "/root")
(string-append "," options)
"")))))
+ (define (mount-cifs source mount-point type flags options)
+ ;; Source is of form "//<server-ip-or-host>/<service>"
+ (let* ((regex-match (string-match "//([^/]+)/(.+)" source))
+ (server (match:substring regex-match 1))
+ (share (match:substring regex-match 2))
+ ;; Match ",guest,", ",guest$", "^guest,", or "^guest$," not
+ ;; e.g. user=foo,pass=notaguest
+ (guest? (string-match "(^|,)(guest)($|,)" options))
+ ;; Perform DNS resolution now instead of attempting kernel dns
+ ;; resolver upcalling. /sbin/request-key does not exist and the
+ ;; kernel hardcodes the path.
+ ;;
+ ;; (getaddrinfo) doesn't support cifs service, so omit it.
+ (inet-addr (host-to-ip server)))
+ (mount source mount-point type flags
+ (string-append "ip="
+ inet-addr
+ ;; As of Linux af1a3d2ba9 (v5.11) unc is ignored
+ ;; and source is parsed by the kernel
+ ;; directly. Pass it for compatibility.
+ ",unc="
+ ;; Match format of mount.cifs's mount syscall.
+ "\\\\" server "\\" share
+ (if guest?
+ ",user=,pass="
+ "")
+ (if options
+ ;; No need to delete "guest" from options.
+ ;; linux/fs/smb/client/fs_context.c explicitly
+ ;; ignores it. Also, avoiding excess commas
+ ;; when deleting is a pain.
+ (string-append "," options)
+ "")))))
+
(let* ((type (file-system-type fs))
(source (canonicalize-device-spec (file-system-device fs)))
(target (string-append root "/"
@@ -1215,6 +1254,8 @@ (define* (mount-file-system fs #:key (root "/root")
(cond
((string-prefix? "nfs" type)
(mount-nfs source target type flags options))
+ ((string-prefix? "cifs" type)
+ (mount-cifs source target type flags options))
((memq 'shared (file-system-flags fs))
(mount source target type flags options)
(mount "none" target #f MS_SHARED))
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0be9ebbc0d 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -222,7 +222,8 @@ (define (machine-check-file-system-availability machine)
(not (member (file-system-type fs)
%pseudo-file-system-types))
;; Don't try to validate network file systems.
- (not (string-prefix? "nfs" (file-system-type fs)))
+ (not (or (string-prefix? "nfs" (file-system-type fs))
+ (string-prefix? "cifs" (file-system-type fs))))
(not (memq 'bind-mount (file-system-flags fs)))))
(operating-system-file-systems (machine-operating-system machine))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 2260bcf985..99c58f3812 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -591,7 +591,8 @@ (define (check-file-system-availability file-systems)
(not (member (file-system-type fs)
%pseudo-file-system-types))
;; Don't try to validate network file systems.
- (not (string-prefix? "nfs" (file-system-type fs)))
+ (not (or (string-prefix? "nfs" (file-system-type fs))
+ (string-prefix? "cifs" (file-system-type fs))))
(not (memq 'bind-mount (file-system-flags fs)))))
file-systems))
--
2.41.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.