X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fauth-source.el;h=26994d5dca109fea4d892f84f965a509e1afd6e9;hp=c8810bcd05016ec0fde88c4dc6281e97c042e7bf;hb=d8b872b8a3b98292e6f3e81f5d40ba263c55ce2b;hpb=3126bc20b0eb30ea691b99ba636deecc3d2772cd diff --git a/lisp/auth-source.el b/lisp/auth-source.el index c8810bcd0..26994d5dc 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1,6 +1,6 @@ ;;; auth-source.el --- authentication sources for Gnus and Emacs -;; Copyright (C) 2008-2012 Free Software Foundation, Inc. +;; Copyright (C) 2008-2015 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news @@ -243,16 +243,14 @@ If the value is a function, debug messages are logged by calling (defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.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\" and the famous -\"~/.netrc\" file. - -See the auth.info manual for details. - Each entry is the authentication type with optional properties. +Entries are tried in the order in which they appear. +See Info node `(auth)Help for users' for details. + +If an entry names a file with the \".gpg\" extension and you have +EPA/EPG set up, the file will be encrypted and decrypted +automatically. See Info node `(epa)Encrypting/decrypting gpg files' +for details. It's best to customize this with `M-x customize-variable' because the choices can get pretty complex." @@ -261,15 +259,15 @@ can get pretty complex." :type `(repeat :tag "Authentication Sources" (choice (string :tag "Just a file") - (const :tag "Default Secrets API Collection" 'default) + (const :tag "Default Secrets API Collection" default) (const :tag "Login Secrets API Collection" "secrets:Login") (const :tag "Temp Secrets API Collection" "secrets:session") (const :tag "Default internet Mac OS Keychain" - 'macos-keychain-internet) + macos-keychain-internet) (const :tag "Default generic Mac OS Keychain" - 'macos-keychain-generic) + macos-keychain-generic) (list :tag "Source definition" (const :format "" :value :source) @@ -280,7 +278,7 @@ can get pretty complex." (const :format "" :value :secrets) (choice :tag "Collection to use" (string :tag "Collection name") - (const :tag "Default" 'default) + (const :tag "Default" default) (const :tag "Login" "Login") (const :tag "Temporary" "session"))) @@ -290,14 +288,14 @@ can get pretty complex." :value :macos-keychain-internet) (choice :tag "Collection to use" (string :tag "internet Keychain path") - (const :tag "default" 'default))) + (const :tag "default" default))) (list :tag "Mac OS generic Keychain" (const :format "" :value :macos-keychain-generic) (choice :tag "Collection to use" (string :tag "generic Keychain path") - (const :tag "default" 'default)))) + (const :tag "default" default)))) (repeat :tag "Extra Parameters" :inline t (choice :tag "Extra parameter" (list @@ -666,9 +664,11 @@ Use `auth-source-delete' in ELisp code instead of calling 'secrets are the only ones supported right now. :max N means to try to return at most N items (defaults to 1). -When 0 the function will return just t or nil to indicate if any -matches were found. More than N items may be returned, depending -on the search and the backend. +More than N items may be returned, depending on the search and +the backend. + +When :max is 0 the function will return just t or nil to indicate +if any matches were found. :host (X Y Z) means to match only hosts X, Y, or Z according to the match rules above. Defaults to t. @@ -769,18 +769,22 @@ must call it to obtain the actual value." (when auth-source-do-cache (auth-source-remember spec found))) - found)) + (if (zerop max) + (not (null found)) + found))) (defun auth-source-search-backends (backends spec max create delete require) - (let (matches) + (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero + matches) (dolist (backend backends) - (when (> max (length matches)) ; when we need more matches... + (when (> max (length matches)) ; if we need more matches... (let* ((bmatches (apply (slot-value backend 'search-function) :backend backend :type (slot-value backend :type) ;; note we're overriding whatever the spec - ;; has for :require, :create, and :delete + ;; has for :max, :require, :create, and :delete + :max max :require require :create create :delete delete @@ -795,6 +799,7 @@ must call it to obtain the actual value." (setq matches (append matches bmatches)))))) matches)) +;; (auth-source-search :max 0) ;; (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) @@ -811,7 +816,7 @@ Returns the deleted entries." (auth-source-search (plist-put spec :delete t))) (defun auth-source-search-collection (collection value) - "Returns t is VALUE is t or COLLECTION is t or contains VALUE." + "Returns t is VALUE is t or COLLECTION is t or COLLECTION contains VALUE." (when (and (atom collection) (not (eq t collection))) (setq collection (list collection))) @@ -923,7 +928,7 @@ while \(:host t) would find all host entries." (when (and c v) (setq prompt (replace-regexp-in-string (format "%%%c" c) (format "%s" v) - prompt))))) + prompt nil t))))) prompt) (defun auth-source-ensure-strings (values) @@ -952,7 +957,7 @@ while \(:host t) would find all host entries." (defun auth-source--aget (alist key) (cdr (assoc key alist))) -;; (auth-source-netrc-parse "~/.authinfo.gpg") +;; (auth-source-netrc-parse :file "~/.authinfo.gpg") (defun* auth-source-netrc-parse (&rest spec &key file max host user port delete require @@ -965,15 +970,41 @@ Note that the MAX parameter is used so we can exit the parse early." (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 + (let* ((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) + (check (lambda(alist) + (and alist + (auth-source-search-collection + host + (or + (auth-source--aget alist "machine") + (auth-source--aget alist "host") + t)) + (auth-source-search-collection + user + (or + (auth-source--aget alist "login") + (auth-source--aget alist "account") + (auth-source--aget alist "user") + t)) + (auth-source-search-collection + port + (or + (auth-source--aget alist "port") + (auth-source--aget alist "protocol") + t)) + (or + ;; the required list of keys is nil, or + (null require) + ;; every element of require is in n(ormalized) + (let ((n (nth 0 (auth-source-netrc-normalize + (list alist) file)))) + (loop for req in require + always (plist-get n req))))))) + result) (if (and (functionp cached-secrets) (equal cached-mtime @@ -993,85 +1024,10 @@ Note that the MAX parameter is used so we can exit the parse early." :secret (lexical-let ((v (mapcar '1+ (buffer-string)))) (lambda () (apply 'string (mapcar '1- v))))))) (goto-char (point-min)) - ;; Go through the file, line by line. - (while (and (not (eobp)) - (> max 0)) - - (narrow-to-region (point) (point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - ;; Skip lines that begin with a "#". - (if (eq (char-after) ?#) - (goto-char (point-max)) - (unless (eobp) - (setq elem - (if (= (following-char) ?\") - (read (current-buffer)) - (buffer-substring - (point) (progn (skip-chars-forward "^\t ") - (point))))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. - (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored, - ;; except "default". - (when (and pair (or (cdr pair) - (equal (car pair) "default"))) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil))))))) - - (when (and alist - (> max 0) - (auth-source-search-collection - host - (or - (auth-source--aget alist "machine") - (auth-source--aget alist "host") - t)) - (auth-source-search-collection - user - (or - (auth-source--aget alist "login") - (auth-source--aget alist "account") - (auth-source--aget alist "user") - t)) - (auth-source-search-collection - port - (or - (auth-source--aget alist "port") - (auth-source--aget alist "protocol") - t)) - (or - ;; the required list of keys is nil, or - (null require) - ;; every element of require is in the normalized list - (let ((normalized (nth 0 (auth-source-netrc-normalize - (list alist) file)))) - (loop for req in require - always (plist-get normalized req))))) - (decf max) - (push (nreverse alist) result) - ;; to delete a line, we just comment it out - (when delete - (goto-char (point-min)) - (insert "#") - (incf modified))) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) + (let ((entries (auth-source-netrc-parse-entries check max)) + alist) + (while (setq alist (pop entries)) + (push (nreverse alist) result))) (when (< 0 modified) (when auth-source-gpg-encrypt-to @@ -1094,6 +1050,77 @@ Note that the MAX parameter is used so we can exit the parse early." (nreverse result)))))) +(defun auth-source-netrc-parse-next-interesting () + "Advance to the next interesting position in the current buffer." + ;; If we're looking at a comment or are at the end of the line, move forward + (while (or (looking-at "#") + (and (eolp) + (not (eobp)))) + (forward-line 1)) + (skip-chars-forward "\t ")) + +(defun auth-source-netrc-parse-one () + "Read one thing from the current buffer." + (auth-source-netrc-parse-next-interesting) + + (when (or (looking-at "'\\([^']*\\)'") + (looking-at "\"\\([^\"]*\\)\"") + (looking-at "\\([^ \t\n]+\\)")) + (forward-char (length (match-string 0))) + (auth-source-netrc-parse-next-interesting) + (match-string-no-properties 1))) + +;; with thanks to org-mode +(defsubst auth-source-current-line (&optional pos) + (save-excursion + (and pos (goto-char pos)) + ;; works also in narrowed buffer, because we start at 1, not point-min + (+ (if (bolp) 1 0) (count-lines 1 (point))))) + +(defun auth-source-netrc-parse-entries(check max) + "Parse up to MAX netrc entries, passed by CHECK, from the current buffer." + (let ((adder (lambda(check alist all) + (when (and + alist + (> max (length all)) + (funcall check alist)) + (push alist all)) + all)) + item item2 all alist default) + (while (setq item (auth-source-netrc-parse-one)) + (setq default (equal item "default")) + ;; We're starting a new machine. Save the old one. + (when (and alist + (or default + (equal item "machine"))) + ;; (auth-source-do-trivia + ;; "auth-source-netrc-parse-entries: got entry %S" alist) + (setq all (funcall adder check alist all) + alist nil)) + ;; In default entries, we don't have a next token. + ;; We store them as ("machine" . t) + (if default + (push (cons "machine" t) alist) + ;; Not a default entry. Grab the next item. + (when (setq item2 (auth-source-netrc-parse-one)) + ;; Did we get a "machine" value? + (if (equal item2 "machine") + (progn + (gnus-error 1 + "%s: Unexpected 'machine' token at line %d" + "auth-source-netrc-parse-entries" + (auth-source-current-line)) + (forward-line 1)) + (push (cons item item2) alist))))) + + ;; Clean up: if there's an entry left over, use it. + (when alist + (setq all (funcall adder check alist all)) + ;; (auth-source-do-trivia + ;; "auth-source-netrc-parse-entries: got2 entry %S" alist) + ) + (nreverse all))) + (defvar auth-source-passphrase-alist nil) (defun auth-source-token-passphrase-callback-function (context key-id file) @@ -1496,6 +1523,31 @@ Respects `auth-source-save-behavior'. Uses ;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1)) ;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git")) +(defun auth-source-secrets-listify-pattern (pattern) + "Convert a pattern with lists to a list of string patterns. + +auth-source patterns can have values of the form :foo (\"bar\" +\"qux\"), which means to match any secret with :foo equal to +\"bar\" or :foo equal to \"qux\". The secrets backend supports +only string values for patterns, so this routine returns a list +of patterns that is equivalent to the single original pattern +when interpreted such that if a secret matches any pattern in the +list, it matches the original pattern." + (if (null pattern) + '(nil) + (let* ((key (pop pattern)) + (value (pop pattern)) + (tails (auth-source-secrets-listify-pattern pattern)) + (heads (if (stringp value) + (list (list key value)) + (mapcar (lambda (v) (list key v)) value)))) + (loop + for h in heads + nconc + (loop + for tl in tails + collect (append h tl)))))) + (defun* auth-source-secrets-search (&rest spec &key backend create delete label @@ -1542,27 +1594,31 @@ authentication tokens: (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :label)) + (ignored-keys '(:create :delete :max :backend :label :require :type)) (search-keys (loop for i below (length spec) by 2 unless (memq (nth i spec) ignored-keys) collect (nth i spec))) ;; build a search spec without the ignored keys ;; if a search key is nil or t (match anything), we skip it - (search-spec (apply 'append (mapcar + (search-specs (auth-source-secrets-listify-pattern + (apply 'append (mapcar (lambda (k) (if (or (null (plist-get spec k)) (eq t (plist-get spec k))) nil (list k (plist-get spec k)))) - search-keys))) + search-keys)))) ;; needed keys (always including host, login, port, and secret) (returned-keys (mm-delete-duplicates (append '(:host :login :port :secret) search-keys))) - (items (loop for item in (apply 'secrets-search-items coll search-spec) - unless (and (stringp label) - (not (string-match label item))) - collect item)) + (items + (loop for search-spec in search-specs + nconc + (loop for item in (apply 'secrets-search-items coll search-spec) + unless (and (stringp label) + (not (string-match label item))) + collect item))) ;; TODO: respect max in `secrets-search-items', not after the fact (items (butlast items (- (length items) max))) ;; convert the item name to a full plist @@ -1614,6 +1670,7 @@ authentication tokens: ;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1)) ;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org")) +;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1)) (defun* auth-source-macos-keychain-search (&rest spec @@ -1740,29 +1797,29 @@ entries for git.gnus.org: (while (not (eobp)) (cond ((looking-at "^password: \"\\(.+\\)\"$") - (auth-source-macos-keychain-result-append - ret - keychain-generic - "secret" - (lexical-let ((v (match-string 1))) - (lambda () v)))) + (setq ret (auth-source-macos-keychain-result-append + ret + keychain-generic + "secret" + (lexical-let ((v (match-string 1))) + (lambda () v))))) ;; TODO: check if this is really the label ;; match 0x00000007 ="AppleID" ((looking-at "^[ ]+0x00000007 =\"\\(.+\\)\"") - (auth-source-macos-keychain-result-append - ret - keychain-generic - "label" - (match-string 1))) + (setq ret (auth-source-macos-keychain-result-append + ret + keychain-generic + "label" + (match-string 1)))) ;; match "crtr"="aapl" ;; match "svce"="AppleID" ((looking-at "^[ ]+\"\\([a-z]+\\)\"[^=]+=\"\\(.+\\)\"") - (auth-source-macos-keychain-result-append - ret - keychain-generic - (match-string 1) - (match-string 2)))) - (forward-line))) + (setq ret (auth-source-macos-keychain-result-append + ret + keychain-generic + (match-string 1) + (match-string 2))))) + (forward-line))) ;; return `ret' iff it has the :secret key (and (plist-get ret :secret) (list ret)))) @@ -1797,7 +1854,7 @@ entries for git.gnus.org: "Search the PLSTORE; spec is like `auth-source'." (let* ((store (oref backend data)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :require)) + (ignored-keys '(:create :delete :max :backend :label :require :type)) (search-keys (loop for i below (length spec) by 2 unless (memq (nth i spec) ignored-keys) collect (nth i spec)))