mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
file-systems: Allow specifying CIFS credentials in a file.
As files in the store and /etc/fstab are world readable, specifying the password in the file-system record is suboptimal. To mitigate this, `mount.cifs' supports reading `username', `password' and `domain' options from a file named by the `credentials' or `cred' option. * gnu/build/file-systems.scm (mount-file-system): Read mount options from the file specified via the `credentials' or `cred' option if specified. Change-Id: I786c5da373fc26d45fe7a876c56a8c4854d18532 Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
parent
b631640f3b
commit
2cbdec8bcd
1 changed files with 42 additions and 0 deletions
|
@ -39,6 +39,7 @@ (define-module (gnu build file-systems)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
|
#:use-module (ice-9 string-fun)
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
#:autoload (system repl repl) (start-repl)
|
#:autoload (system repl repl) (start-repl)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -1187,6 +1188,39 @@ (define (mount-nfs source mount-point type flags options)
|
||||||
(string-append "," options)
|
(string-append "," options)
|
||||||
"")))))
|
"")))))
|
||||||
|
|
||||||
|
(define (read-cifs-credential-file file)
|
||||||
|
;; Read password, user and domain options from file
|
||||||
|
;;
|
||||||
|
;; XXX: As of version 7.0, mount.cifs strips all lines of leading
|
||||||
|
;; whitespace, parses those starting with "pass", "user" and "dom" into
|
||||||
|
;; "pass=", "user=" and "domain=" options respectively and ignores
|
||||||
|
;; everything else. To simplify the implementation, we pass those lines
|
||||||
|
;; as is. As a consequence, the "password2" option can be specified in a
|
||||||
|
;; credential file with the expected semantics (see:
|
||||||
|
;; https://issues.guix.gnu.org/71594#3).
|
||||||
|
(with-input-from-file file
|
||||||
|
(lambda ()
|
||||||
|
(let loop
|
||||||
|
((next-line (read-line))
|
||||||
|
(lines '()))
|
||||||
|
(match next-line
|
||||||
|
((? eof-object?)
|
||||||
|
lines)
|
||||||
|
((= string-trim line)
|
||||||
|
(loop (read-line)
|
||||||
|
(cond
|
||||||
|
((string-prefix? "pass" line)
|
||||||
|
;; mount.cifs escapes commas in the password by doubling
|
||||||
|
;; them
|
||||||
|
(cons (string-replace-substring line "," ",,")
|
||||||
|
lines))
|
||||||
|
((or (string-prefix? "user" line)
|
||||||
|
(string-prefix? "dom" line))
|
||||||
|
(cons line lines))
|
||||||
|
;; Ignore all other lines.
|
||||||
|
(else
|
||||||
|
lines)))))))))
|
||||||
|
|
||||||
(define (mount-cifs source mount-point type flags options)
|
(define (mount-cifs source mount-point type flags options)
|
||||||
;; Source is of form "//<server-ip-or-host>/<service>"
|
;; Source is of form "//<server-ip-or-host>/<service>"
|
||||||
(let* ((regex-match (string-match "//([^/]+)/(.+)" source))
|
(let* ((regex-match (string-match "//([^/]+)/(.+)" source))
|
||||||
|
@ -1195,6 +1229,9 @@ (define (mount-cifs source mount-point type flags options)
|
||||||
;; Match ",guest,", ",guest$", "^guest,", or "^guest$," not
|
;; Match ",guest,", ",guest$", "^guest,", or "^guest$," not
|
||||||
;; e.g. user=foo,pass=notaguest
|
;; e.g. user=foo,pass=notaguest
|
||||||
(guest? (string-match "(^|,)(guest)($|,)" options))
|
(guest? (string-match "(^|,)(guest)($|,)" options))
|
||||||
|
(credential-file (and=> (string-match "(^|,)(credentials|cred)=([^,]+)(,|$)"
|
||||||
|
options)
|
||||||
|
(cut match:substring <> 3)))
|
||||||
;; Perform DNS resolution now instead of attempting kernel dns
|
;; Perform DNS resolution now instead of attempting kernel dns
|
||||||
;; resolver upcalling. /sbin/request-key does not exist and the
|
;; resolver upcalling. /sbin/request-key does not exist and the
|
||||||
;; kernel hardcodes the path.
|
;; kernel hardcodes the path.
|
||||||
|
@ -1219,6 +1256,11 @@ (define (mount-cifs source mount-point type flags options)
|
||||||
;; ignores it. Also, avoiding excess commas
|
;; ignores it. Also, avoiding excess commas
|
||||||
;; when deleting is a pain.
|
;; when deleting is a pain.
|
||||||
(string-append "," options)
|
(string-append "," options)
|
||||||
|
"")
|
||||||
|
(if credential-file
|
||||||
|
;; The "credentials" option is ignored too.
|
||||||
|
(string-join (read-cifs-credential-file credential-file)
|
||||||
|
"," 'prefix)
|
||||||
"")))))
|
"")))))
|
||||||
|
|
||||||
(let* ((type (file-system-type fs))
|
(let* ((type (file-system-type fs))
|
||||||
|
|
Loading…
Reference in a new issue