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>master
parent
b631640f3b
commit
2cbdec8bcd
|
@ -39,6 +39,7 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 string-fun)
|
||||
#:use-module (system foreign)
|
||||
#:autoload (system repl repl) (start-repl)
|
||||
#:use-module (srfi srfi-1)
|
||||
|
@ -1187,6 +1188,39 @@ corresponds to the symbols listed in FLAGS."
|
|||
(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)
|
||||
;; Source is of form "//<server-ip-or-host>/<service>"
|
||||
(let* ((regex-match (string-match "//([^/]+)/(.+)" source))
|
||||
|
@ -1195,6 +1229,9 @@ corresponds to the symbols listed in FLAGS."
|
|||
;; Match ",guest,", ",guest$", "^guest,", or "^guest$," not
|
||||
;; e.g. user=foo,pass=notaguest
|
||||
(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
|
||||
;; resolver upcalling. /sbin/request-key does not exist and the
|
||||
;; kernel hardcodes the path.
|
||||
|
@ -1219,6 +1256,11 @@ corresponds to the symbols listed in FLAGS."
|
|||
;; ignores it. Also, avoiding excess commas
|
||||
;; when deleting is a pain.
|
||||
(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))
|
||||
|
|
Reference in New Issue