(require 'password-cache)
(require 'mm-util)
(require 'gnus-util)
-(require 'netrc)
(require 'assoc)
(eval-when-compile (require 'cl))
(eval-and-compile
:version "23.2" ;; No Gnus
:type `boolean)
-(defcustom auth-source-debug t
+(defcustom auth-source-debug nil
"Whether auth-source should log debug messages.
If the value is nil, debug messages are not logged.
:type `(choice
:tag "auth-source debugging mode"
(const :tag "Log using `message' to the *Messages* buffer" t)
+ (const :tag "Log all trivia with `message' to the *Messages* buffer"
+ trivia)
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
-(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
+(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
"List of authentication sources.
The default will get login and password information from
\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
packages to be encrypted. If that file doesn't exist, it will
-try the unencrypted version \"~/.authinfo\".
+try the unencrypted version \"~/.authinfo\" and the famous
+\"~/.netrc\" file.
See the auth.info manual for details.
(when auth-source-debug
(apply 'auth-source-do-warn msg)))
+(defun auth-source-do-trivia (&rest msg)
+ (when (or (eq auth-source-debug 'trivia)
+ (functionp auth-source-debug))
+ (apply 'auth-source-do-warn msg)))
+
(defun auth-source-do-warn (&rest msg)
(apply
;; set logger to either the function in auth-source-debug or 'message
search to find only entries that have P set to 'pppp'.\"
When multiple values are specified in the search parameter, the
-first one is used for creation. So :host (X Y Z) would create a
-token for host X, for instance.
+user is prompted for which one. So :host (X Y Z) would ask the
+user to choose between X, Y, and Z.
This creation can fail if the search was not specific enough to
create a new token (it's up to the backend to decide that). You
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
(found (auth-source-recall spec))
- filtered-backends accessor-key found-here goal)
+ filtered-backends accessor-key backend)
(if (and found auth-source-do-cache)
(auth-source-do-debug
(assert
(or (eq t create) (listp create)) t
- "Invalid auth-source :create parameter (must be nil, t, or a list): %s %s")
+ "Invalid auth-source :create parameter (must be t or a list): %s %s")
(setq filtered-backends (copy-sequence backends))
(dolist (backend backends)
(return))
(invalid-slot-name))))
- (auth-source-do-debug
+ (auth-source-do-trivia
"auth-source-search: found %d backends matching %S"
(length filtered-backends) spec)
;; (debug spec "filtered" filtered-backends)
- (setq goal max)
- (dolist (backend filtered-backends)
- (setq found-here (apply
- (slot-value backend 'search-function)
- :backend backend
- :create create
- :delete delete
- spec))
-
- ;; if max is 0, as soon as we find something, return it
- (when (and (zerop max) (> 0 (length found-here)))
- (return t))
-
- ;; decrement the goal by the number of new results
- (decf goal (length found-here))
- ;; and append the new results to the full list
- (setq found (append found found-here))
-
- (auth-source-do-debug
- "auth-source-search: found %d results (max %d/%d) in %S matching %S"
- (length found-here) max goal backend spec)
-
- ;; return full list if the goal is 0 or negative
- (when (zerop (max 0 goal))
- (return found))
+ ;; First go through all the backends without :create, so we can
+ ;; query them all.
+ (setq found (auth-source-search-backends filtered-backends
+ spec
+ ;; to exit early
+ max
+ ;; create and delete
+ nil delete))
- ;; change the :max parameter in the spec to the goal
- (setq spec (plist-put spec :max goal)))
+ (auth-source-do-debug
+ "auth-source-search: found %d results (max %d) matching %S"
+ (length found) max spec)
+
+ ;; If we didn't find anything, then we allow the backend(s) to
+ ;; create the entries.
+ (when (and create
+ (not found))
+ (setq found (auth-source-search-backends filtered-backends
+ spec
+ ;; to exit early
+ max
+ ;; create and delete
+ create delete))
+ (auth-source-do-warn
+ "auth-source-search: CREATED %d results (max %d) matching %S"
+ (length found) max spec))
(when (and found auth-source-do-cache)
(auth-source-remember spec found)))
found))
+(defun auth-source-search-backends (backends spec max create delete)
+ (let (matches)
+ (dolist (backend backends)
+ (when (> max (length matches)) ; when we need more matches...
+ (let ((bmatches (apply
+ (slot-value backend 'search-function)
+ :backend backend
+ ;; note we're overriding whatever the spec
+ ;; has for :create and :delete
+ :create create
+ :delete delete
+ spec)))
+ (when bmatches
+ (auth-source-do-trivia
+ "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
+ (length bmatches) max
+ (slot-value backend :type)
+ (slot-value backend :source)
+ spec)
+ (setq matches (append matches bmatches))))))
+ matches))
+
;;; (auth-source-search :max 1)
;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
;;; Backend specific parsing: netrc/authinfo backend
+(defun auth-source-ensure-strings (values)
+ (unless (listp values)
+ (setq values (list values)))
+ (mapcar (lambda (value)
+ (if (numberp value)
+ (format "%s" value)
+ value))
+ values))
+
+(defvar auth-source-netrc-cache nil)
+
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
spec
;; We got already parsed contents; just return it.
file
(when (file-exists-p file)
+ (setq port (auth-source-ensure-strings port))
(with-temp-buffer
- (let ((tokens '("machine" "host" "default" "login" "user"
- "password" "account" "macdef" "force"
- "port" "protocol"))
- (max (or max 5000)) ; sanity check: default to stop at 5K
- (modified 0)
- alist elem result pair)
- (insert-file-contents file)
+ (let* ((tokens '("machine" "host" "default" "login" "user"
+ "password" "account" "macdef" "force"
+ "port" "protocol"))
+ (max (or max 5000)) ; sanity check: default to stop at 5K
+ (modified 0)
+ (cached (cdr-safe (assoc file auth-source-netrc-cache)))
+ (cached-mtime (plist-get cached :mtime))
+ (cached-secrets (plist-get cached :secret))
+ alist elem result pair)
+
+ (if (and (functionp cached-secrets)
+ (equal cached-mtime
+ (nth 5 (file-attributes file))))
+ (progn
+ (auth-source-do-trivia
+ "auth-source-netrc-parse: using CACHED file data for %s"
+ file)
+ (insert (funcall cached-secrets)))
+ (insert-file-contents file)
+ ;; cache all netrc files (used to be just .gpg files)
+ ;; Store the contents of the file heavily encrypted in memory.
+ ;; (note for the irony-impaired: they are just obfuscated)
+ (aput 'auth-source-netrc-cache file
+ (list :mtime (nth 5 (file-attributes file))
+ :secret (lexical-let ((v (rot13-string
+ (base64-encode-string
+ (buffer-string)))))
+ (lambda () (base64-decode-string
+ (rot13-string v)))))))
(goto-char (point-min))
;; Go through the file, line by line.
(while (and (not (eobp))
;; if we need to create an entry AND none were found to match
(when (and create
- (= 0 (length results)))
+ (not results))
;; create based on the spec and record the value
(setq results (or
(plist-put spec :create nil)))))
results))
+(defun auth-source-netrc-element-or-first (v)
+ (if (listp v)
+ (nth 0 v)
+ v))
+
;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
;; only for base required elements (defined as function parameters):
;; fill in the valist with whatever data we may have from the search
- ;; we take the first value if it's a list, the whole value otherwise
+ ;; we complete the first value if it's a list and use the value otherwise
(dolist (br base-required)
(when (symbol-value br)
- (aput 'valist br (if (listp (symbol-value br))
- (nth 0 (symbol-value br))
- (symbol-value br)))))
+ (let ((br-choice (cond
+ ;; all-accepting choice (predicate is t)
+ ((eq t (symbol-value br)) nil)
+ ;; just the value otherwise
+ (t (symbol-value br)))))
+ (when br-choice
+ (aput 'valist br br-choice)))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
;; for each required element
(dolist (r required)
(let* ((data (aget valist r))
+ ;; take the first element if the data is a list
+ (data (auth-source-netrc-element-or-first data))
+ ;; this is the default to be offered
(given-default (aget auth-source-creation-defaults r))
- ;; the defaults are simple
+ ;; the default supplementals are simple: for the user,
+ ;; try (user-login-name), otherwise take given-default
(default (cond
((and (not given-default) (eq r 'user))
(user-login-name))
- ;; note we need this empty string
- ((and (not given-default) (eq r 'port))
- "")
- (t given-default)))
- ;; the prompt's default string depends on the data so far
- (default-string (if (and default (< 0 (length default)))
- (format " (default %s)" default)
- " (no default)"))
- ;; the prompt should also show what's entered so far
- (user-value (aget valist 'user))
- (host-value (aget valist 'host))
- (port-value (aget valist 'port))
- (info-so-far (concat (if user-value
- (format "%s@" user-value)
- "[USER?]")
- (if host-value
- (format "%s" host-value)
- "[HOST?]")
- (if port-value
- ;; this distinguishes protocol between
- (if (zerop (length port-value))
- "" ; 'entered as "no default"' vs.
- (format ":%s" port-value)) ; given
- ;; and this is when the protocol is unknown
- "[PORT?]"))))
-
- ;; now prompt if the search SPEC did not include a required key;
- ;; take the result and put it in `data' AND store it in `valist'
- (aput 'valist r
- (setq data
- (cond
- ((and (null data) (eq r 'secret))
- ;; special case prompt for passwords
- (read-passwd (format "Password for %s: " info-so-far)))
- ((null data)
- (read-string
- (format "Enter %s for %s%s: "
- r info-so-far default-string)
- nil nil default))
- (t data))))
+ (t given-default))))
+
+ ;; store the data, prompting for the password if needed
+ (setq data
+ (cond
+ ((and (null data) (eq r 'secret))
+ ;; special case prompt for passwords
+ (read-passwd (format "Password for %s@%s:%s: "
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'user))
+ (plist-get artificial :user)
+ "[any user]")
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'host))
+ (plist-get artificial :host)
+ "[any host]")
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'port))
+ (plist-get artificial :port)
+ "[any port]"))))
+ (t (or data default))))
(when data
(setq artificial (plist-put artificial
;; when r is not an empty string...
(when (and (stringp data)
(< 0 (length data)))
- ;; append the key (the symbol name of r) and the value in r
- (setq add (concat add
- (format "%s%s %S"
- ;; prepend a space
- (if (zerop (length add)) "" " ")
- ;; remap auth-source tokens to netrc
- (case r
- ('user "login")
- ('host "machine")
+ ;; this function is not strictly necessary but I think it
+ ;; makes the code clearer -tzz
+ (let ((printer (lambda ()
+ ;; append the key (the symbol name of r)
+ ;; and the value in r
+ (format "%s%s %S"
+ ;; prepend a space
+ (if (zerop (length add)) "" " ")
+ ;; remap auth-source tokens to netrc
+ (case r
+ ('user "login")
+ ('host "machine")
('secret "password")
- ('port "port") ; redundant but clearer
+ ('port "port") ; redundant but clearer
(t (symbol-name r)))
- ;; the value will be printed in %S format
- data))))))
+ ;; the value will be printed in %S format
+ data))))
+ (setq add (concat add (funcall printer)))))))
(with-temp-buffer
(when (file-exists-p file)
(goto-char (point-max))
;; ask AFTER we've successfully opened the file
- (if (y-or-n-p (format "Add to file %s: line [%s]" file add))
+ (let ((prompt (format "Add to file %s? %s: "
+ file
+ "(y)es/(n)o but use it/(e)dit line/(s)kip file"))
+ done k)
+ (while (not done)
+ (message "%s" prompt)
+ (setq k (read-char))
+ (case k
+ (?y (setq done t))
+ (?n (setq add ""
+ done t))
+ (?s (setq add ""
+ done 'skip))
+ (?e (setq add (read-string "Line to add: " add)))
+ (t nil)))
+
+ (when (< 0 (length add))
(progn
(unless (bolp)
(insert "\n"))
(insert add "\n")
(write-region (point-min) (point-max) file nil 'silent)
- (auth-source-do-debug
+ (auth-source-do-warn
"auth-source-netrc-create: wrote 1 new line to %s"
file)
- nil)
- (list artificial)))))
+ nil))
+
+ (when (eq done t)
+ (list artificial))))))
;;; Backend specific parsing: Secrets API backend
projects / gnus / blobdiff