[gnus git] branch tzz-auth-source-rewrite created: =0=
Lars Ingebrigtsen <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
at c29bed20521bd1925c62ef3a340bafca5b7be931 (commit) - Log ----------------------------------------------------------------- commit c29bed20521bd1925c62ef3a340bafca5b7be931 Merge: 9b636e0 829f8a0 Author: Ted Zlatanov <[email protected]> Date: Fri Feb 4 10:49:56 2011 -0600 Merge branch 'master' of https://git.gnus.org/gnus into tzz-auth-source-rewrite diff --cc lisp/ChangeLog index 36f8da3,24cf7dd..2845326 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@@ -1,28 -1,10 +1,33 @@@ +2011-02-04 Teodor Zlatanov <[email protected]> + + * auth-source.el: Bring in assoc and eioeio libraries. + (secrets-enabled): New variable to track the status of the Secrets API. + (auth-source-backend): New EIOEIO class to represent a backend. + (auth-source-creation-defaults): New variable to set prompt defaults + during token creation (see the `auth-source-search' docstring for + details). + (auth-sources): Simplify to allow a simple string as a netrc backend + spec. + (auth-source-backend-parse): Parse a backend from an `auth-sources' spec. + (auth-source-backend-parse-parameters): Fill in the backend parameters. + (auth-source-search): Main auth-source API entry point. + (auth-source-delete): Wrapper around `auth-source-search' for deletion. + (auth-source-search-collection): Helper function for searching. + (auth-source-netrc-parse, auth-source-netrc-normalize) + (auth-source-netrc-search, auth-source-netrc-create): Netrc backend. + Supports search, create, and delete. + (auth-source-secrets-search, auth-source-secrets-create): Secrets API + backend stubs. + (auth-source-user-or-password): Call `auth-source-search' but it's not + ready yet. + 2011-02-04 Lars Ingebrigtsen <[email protected]> + * gnus-sum.el (gnus-user-date): Renamed back from + gnus-summary-user-date since user code refers to it. + + * shr.el (shr-render-td): Store the actual background colour used. + * message.el (message-setup-1): Don't bind the constant -forbidden-properties. (message-setup-1): Revert previous change, since it needs to bind the commit 9b636e06873af174de79ebd12b9cc270aba6a11c Author: Ted Zlatanov <[email protected]> Date: Fri Feb 4 10:47:12 2011 -0600 auth-source.el rewrite * auth-source.el: Bring in assoc and eioeio libraries. (secrets-enabled): New variable to track the status of the Secrets API. (auth-source-backend): New EIOEIO class to represent a backend. (auth-source-creation-defaults): New variable to set prompt defaults during token creation (see the `auth-source-search' docstring for details). (auth-sources): Simplify to allow a simple string as a netrc backend spec. (auth-source-backend-parse): Parse a backend from an `auth-sources' spec. (auth-source-backend-parse-parameters): Fill in the backend parameters. (auth-source-search): Main auth-source API entry point. (auth-source-delete): Wrapper around `auth-source-search' for deletion. (auth-source-search-collection): Helper function for searching. (auth-source-netrc-parse, auth-source-netrc-normalize) (auth-source-netrc-search, auth-source-netrc-create): Netrc backend. Supports search, create, and delete. (auth-source-secrets-search, auth-source-secrets-create): Secrets API backend stubs. (auth-source-user-or-password): Call `auth-source-search' but it's not ready yet. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9522f82..36f8da3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,26 @@ +2011-02-04 Teodor Zlatanov <[email protected]> + + * auth-source.el: Bring in assoc and eioeio libraries. + (secrets-enabled): New variable to track the status of the Secrets API. + (auth-source-backend): New EIOEIO class to represent a backend. + (auth-source-creation-defaults): New variable to set prompt defaults + during token creation (see the `auth-source-search' docstring for + details). + (auth-sources): Simplify to allow a simple string as a netrc backend + spec. + (auth-source-backend-parse): Parse a backend from an `auth-sources' spec. + (auth-source-backend-parse-parameters): Fill in the backend parameters. + (auth-source-search): Main auth-source API entry point. + (auth-source-delete): Wrapper around `auth-source-search' for deletion. + (auth-source-search-collection): Helper function for searching. + (auth-source-netrc-parse, auth-source-netrc-normalize) + (auth-source-netrc-search, auth-source-netrc-create): Netrc backend. + Supports search, create, and delete. + (auth-source-secrets-search, auth-source-secrets-create): Secrets API + backend stubs. + (auth-source-user-or-password): Call `auth-source-search' but it's not + ready yet. + 2011-02-04 Lars Ingebrigtsen <[email protected]> * message.el (message-setup-1): Don't bind the constant diff --git a/lisp/auth-source.el b/lisp/auth-source.el index e94cfb1..7566291 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -41,8 +41,10 @@ (require 'gnus-util) (require 'netrc) - +(require 'assoc) (eval-when-compile (require 'cl)) +(eval-when-compile (require 'eieio)) + (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") (autoload 'secrets-get-alias "secrets") @@ -51,11 +53,51 @@ (autoload 'secrets-list-collections "secrets") (autoload 'secrets-search-items "secrets") +(defvar secrets-enabled) + (defgroup auth-source nil "Authentication sources." :version "23.1" ;; No Gnus :group 'gnus) +(defclass auth-source-backend () + ((type :initarg :type + :initform 'netrc + :type symbol + :custom symbol + :documentation "The backend type.") + (source :initarg :source + :type string + :custom string + :documentation "The backend source.") + (host :initarg :host + :initform t + :type t + :custom string + :documentation "The backend host.") + (user :initarg :user + :initform t + :type t + :custom string + :documentation "The backend user.") + (protocol :initarg :protocol + :initform t + :type t + :custom string + :documentation "The backend protocol.") + (create-function :initarg :create-function + :initform ignore + :type function + :custom function + :documentation "The create function.") + (search-function :initarg :search-function + :initform ignore + :type function + :custom function + :documentation "The search function."))) + +;;(auth-source-backend "netrc" :type 'netrc) + (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") (pop3 "pop3" "pop" "pop3s" "110" "995") (ssh "ssh" "22") @@ -81,6 +123,9 @@ p))) auth-source-protocols)) +(defvar auth-source-creation-defaults nil + "Defaults for creating token values. Usually let-bound.") + (defvar auth-source-cache (make-hash-table :test 'equal) "Cache for auth-source data") @@ -115,55 +160,65 @@ Only relevant if `auth-source-debug' is not nil." :version "23.2" ;; No Gnus :type `boolean) -(defcustom auth-sources '((:source "~/.authinfo.gpg") - (:source "~/.authinfo")) +(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo") "List of authentication sources. -The default will get login and password information from a .gpg -file, which you should set up with the EPA/EPG packages to be -encrypted. See the auth.info manual for details. +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\". + +See the auth.info manual for details. Each entry is the authentication type with optional properties. It's best to customize this with `M-x customize-variable' because the choices can get pretty complex." :group 'auth-source - :version "23.2" ;; No Gnus + :version "24.1" ;; No Gnus :type `(repeat :tag "Authentication Sources" + (choice + (string :tag "Just a file") (list :tag "Source definition" (const :format "" :value :source) (choice :tag "Authentication backend choice" (string :tag "Authentication Source (file)") - (list :tag "secrets.el (Secret Service API/KWallet/GNOME Keyring)" + (list + :tag "Secret Service API/KWallet/GNOME Keyring" (const :format "" :value :secrets) (choice :tag "Collection to use" (string :tag "Collection name") (const :tag "Default" 'default) (const :tag "Login" "login") - (const :tag "Temporary" "session")))) + (const + :tag "Temporary" "session")))) (repeat :tag "Extra Parameters" :inline t (choice :tag "Extra parameter" - (list :tag "Host (omit to match as a fallback)" + (list + :tag "Host" (const :format "" :value :host) (choice :tag "Host (machine) choice" (const :tag "Any" t) - (regexp :tag "Host (machine) regular expression"))) - (list :tag "Protocol (omit to match as a fallback)" + (regexp + :tag "Regular expression"))) + (list + :tag "Protocol" (const :format "" :value :protocol) - (choice :tag "Protocol" + (choice + :tag "Protocol" (const :tag "Any" t) ,@auth-source-protocols-customize)) - (list :tag "User (omit to match as a fallback)" :inline t + (list :tag "User" :inline t (const :format "" :value :user) - (choice :tag "Personality or username" + (choice :tag "Personality/Username" (const :tag "Any" t) - (string :tag "Specific user name")))))))) + (string :tag "Name"))))))))) (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. If the value is not a list, symmetric encryption will be used." :group 'auth-source - :version "23.2" ;; No Gnus + :version "24.1" ;; No Gnus :type '(choice (const :tag "Symmetric encryption" t) (repeat :tag "Recipient public keys" (string :tag "Recipient public key")))) @@ -211,55 +266,594 @@ If the value is not a list, symmetric encryption will be used." ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) -(defun auth-get-source (entry) - "Return the source string of ENTRY, which is one entry in `auth-sources'. -If it is a Secret Service API, return the collection name, otherwise -the file name." - (let ((source (plist-get entry :source))) - (if (stringp source) - source - ;; Secret Service API. - (setq source (plist-get source :secrets)) - (when (eq source 'default) - (setq source (or (secrets-get-alias "default") "login"))) - (or source "session")))) - -(defun auth-source-pick (&rest spec) - "Parse `auth-sources' for matches of the SPEC plist. - -Common keys are :host, :protocol, and :user. A value of t in -SPEC means to always succeed in the match. A string value is -matched as a regex." - (let ((keys (loop for i below (length spec) by 2 collect (nth i spec))) - choices) - (dolist (choice (copy-tree auth-sources) choices) - (let ((source (plist-get choice :source)) - (match t)) - (when - (and - ;; Check existence of source. - (if (consp source) - ;; Secret Service API. - (member (auth-get-source choice) (secrets-list-collections)) - ;; authinfo file. - (file-exists-p source)) - - ;; Check keywords. - (dolist (k keys match) - (let* ((v (plist-get spec k)) - (choicev (if (plist-member choice k) - (plist-get choice k) t))) - (setq match - (and match +(defun auth-source-backend-parse (entry) + "Creates an auth-source-backend from an ENTRY in `auth-sources'." + (auth-source-backend-parse-parameters + entry + (cond + ((stringp entry) ; just a file name + (auth-source-backend + entry + :source entry + :type 'netrc + :search-function 'auth-source-netrc-search + :create-function 'auth-source-netrc-create)) + + ;; a file name with parameters + ((stringp (plist-get entry :source)) + (auth-source-backend + (plist-get entry :source) + :source (plist-get entry :source) + :type 'netrc + :search-function 'auth-source-netrc-search + :create-function 'auth-source-netrc-create)) + + ;; the Secrets API. We require the package, in order to have a + ;; defined value for `secrets-enabled'. + ((and (listp (plist-get entry :source)) + (require 'secrets nil t) + secrets-enabled) + + ;; the source is either the :secrets key in ENTRY or + ;; if that's missing or nil, it's "session" + (let ((source (or (plist-get (plist-get entry :source) :secrets) + "session"))) + + ;; if the source is a symbol, we look for the alias named so, + ;; and if that alias is missing, we use "login" + (when (symbolp source) + (setq source (or (secrets-get-alias (symbol-name source)) + "login"))) + + (auth-source-backend + (format "Secrets API (%s)" source) + :source source + :type 'secrets + :search-function 'auth-source-secrets-search + :create-function 'auth-source-secrets-create))) + + ;; none of them + (t (auth-source-backend + "Empty" + :source "" + :type 'ignore))))) + +(defun auth-source-backend-parse-parameters (entry backend) + "Fills in the extra auth-source-backend parameters of ENTRY. +Using the plist ENTRY, get the :host, :protocol, and :user search +parameters. Accepts :port as an alias to :protocol. Sets all +the parameters to t if they are missing." + (let (val) + (when (setq val (plist-get entry :host)) + (oset backend host val)) + (when (setq val (plist-get entry :user)) + (oset backend user val)) + ;; accept :port as an alias for :protocol + (when (setq val (or (plist-get entry :protocol) (plist-get entry :port))) + (oset backend protocol val))) + backend) + +;; (mapcar 'auth-source-backend-parse auth-sources) + +(defun* auth-source-search (&rest spec + &key type max host user protocol secret + create delete + &allow-other-keys) + "Search or modify authentication backends according to SPEC. + +This function parses `auth-sources' for matches of the SPEC +plist. It can optionally create or update an authentication +token if requested. A token is just a standard Emacs property +list with a :secret property that can be a function; all the +other properties will always hold scalar values. + +Typically the :secret property, if present, contains a password. + +Common search keys are :max, :host, :protocol, and :user. In +addition, :create specifies how tokens will be or created. +Finally, :type can specify which backend types you want to check. + +A string value is always matched literally. A symbol is matched +as its string value, literally. All the SPEC values can be +single values (symbol or string) or lists thereof (in which case +any of the search terms matches). + +:create t means to create a token if possible. + +A new token will be created if no matching tokens were found. +The new token will have only the keys the backend requires. For +the netrc backend, for instance, that's the user, host, and +protocol keys. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host \"mine\" :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create t)) + +which says: + +\"Search for any entry matching host 'mine' in backends of type + 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and protocol. The host will be + 'mine'. We prompt for the user with default 'defaultUser' and + for the protocol without a default. We will not prompt for A, Q, + or P. The resulting token will only have keys user, host, and + protocol.\" + +:create '(A B C) also means to create a token if possible. + +The behavior is like :create t but if the list contains any +parameter, that parameter will be required in the resulting +token. The value for that parameter will be obtained from the +search parameters or from user input. If any queries are needed, +the alist `auth-source-creation-defaults' will be checked for the +default prompt. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create '(A B Q))) + +which says: + +\"Search for any entry matching host 'nonesuch' + or 'twosuch' in backends of type 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and protocol. The host will be + 'nonesuch' and Q will be 'qqqq'. We prompt for A with default + 'default A', for B and protocol with default nil, and for the + user with default 'defaultUser'. We will not prompt for Q. The + resulting token will have keys user, host, protocol, A, B, and Q. + It will not have P with any value, even though P is used in the + 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. + +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 +should `catch' the backend-specific error as usual. Some +backends (netrc, at least) will prompt the user rather than throw +an error. + +:delete t means to delete any found entries. nil by default. +Use `auth-source-delete' in ELisp code instead of calling +`auth-source-search' directly with this parameter. + +:type (X Y Z) will check only those backend types. 'netrc and +'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. + +:host (X Y Z) means to match only hosts X, Y, or Z according to +the match rules above. Defaults to t. + +:user (X Y Z) means to match only users X, Y, or Z according to +the match rules above. Defaults to t. + +:protocol (P Q R) means to match only protocols P, Q, or R. +Defaults to t. + +:K (V1 V2 V3) for any other key K will match values V1, V2, or +V3 (note the match rules above). + +The return value is a list with at most :max tokens. Each token +is a plist with keys :backend :host :protocol :user, plus any other +keys provided by the backend (notably :secret). But note the +exception for :max 0, which see above. + +The token's :secret key can hold a function. In that case you +must call it to obtain the actual value." + (let ((backends (mapcar 'auth-source-backend-parse auth-sources)) + (max (or max 1)) + (keys (remove :create (remove :delete (remove :max + (loop for i below (length spec) by 2 + collect (nth i spec)))))) + filtered-backends accessor-key found-here found goal) + (assert (or (eq t create) (listp create)) t + "Invalid auth-source :create parameter (must be nil, t, or a list)") + + (setq filtered-backends (copy-list backends)) + (dolist (backend backends) + (dolist (key keys) + ;; ignore invalid slots + (condition-case signal + (unless (eval `(auth-source-search-collection + (plist-get spec key) + (oref backend ,key))) + (setq filtered-backends (delq backend filtered-backends)) + (return)) + (invalid-slot-name)))) + + (auth-source-do-debug + "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)) + + ;; change the :max parameter in the spec to the goal + (setq spec (plist-put spec :max goal))) + found)) + +;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1) +;;; (auth-source-search :host "nonesuch" :type 'secrets) + +(defun* auth-source-delete (&rest spec + &key delete + &allow-other-keys) + "Delete entries from the authentication backends according to SPEC. +Calls `auth-source-search' with the :delete property in SPEC set to t. +The backend may not actually delete the entries. + +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." + (when (and (atom collection) (not (eq t collection))) + (setq collection (list collection))) + + ;; (debug :collection collection :value value) + (or (eq collection t) + (eq value t) + (equal collection value) + (member value collection))) + +;;; Backend specific parsing: netrc/authinfo backend + +;;; (auth-source-netrc-parse "~/.authinfo.gpg") +(defun* auth-source-netrc-parse (&rest + spec + &key file max host user protocol delete + &allow-other-keys) + "Parse FILE and return a list of all entries in the file. +Note that the MAX parameter is used so we can exit the parse early." + (if (listp file) + ;; We got already parsed contents; just return it. + file + (when (file-exists-p file) + (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) + (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 + (aget alist "machine") + (aget alist "host"))) + (auth-source-search-collection + user + (or + (aget alist "login") + (aget alist "account") + (aget alist "user"))) + (auth-source-search-collection + protocol (or - ;; source always matches spec key - (eq t choicev) - ;; source key gives regex to match against spec - (and (stringp choicev) (string-match choicev v)) - ;; source key gives symbol to match against spec - (and (symbolp choicev) (eq choicev v)))))))) + (aget alist "port") + (aget alist "protocol")))) + (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)) + + (when (< 0 modified) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + + ;; ask AFTER we've successfully opened the file + (when (y-or-n-p (format "Save file %s? (%d modifications)" + file modified)) + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-parse: modified %d lines in %s" + modified file))) + + (nreverse result)))))) + +(defun auth-source-netrc-normalize (alist) + (mapcar (lambda (entry) + (let (ret item) + (while (setq item (pop entry)) + (let ((k (car item)) + (v (cdr item))) + + ;; apply key aliases + (setq k (cond ((member k '("machine")) "host") + ((member k '("login" "account")) "user") + ((member k '("protocol")) "port") + ((member k '("password")) "secret") + (t k))) + + ;; send back the secret in a function (lexical binding) + (when (equal k "secret") + (setq v (lexical-let ((v v)) + (lambda () v)))) + + (setq ret (plist-put ret + (intern (concat ":" k)) + v)) + )) + ret)) + alist)) + +;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) +;;; (funcall secret) + +(defun* auth-source-netrc-search (&rest + spec + &key backend create delete + type max host user protocol + &allow-other-keys) +"Given a property list SPEC, return search matches from the :backend. +See `auth-source-search' for details on SPEC." + ;; just in case, check that the type is correct (null or same as the backend) + (assert (or (null type) (eq type (oref backend type))) + t "Invalid netrc search") + + (let ((results (auth-source-netrc-normalize + (auth-source-netrc-parse + :max max + :delete delete + :file (oref backend source) + :host (or host t) + :user (or user t) + :protocol (or protocol t))))) + + ;; if we need to create an entry AND none were found to match + (when (and create + (= 0 (length results))) + + ;; create based on the spec + (apply (slot-value backend 'create-function) spec) + ;; turn off the :create key + (setq spec (plist-put spec :create nil)) + ;; run the search again to get the updated data + ;; the result will be returned, even if the search fails + (setq results (apply 'auth-source-netrc-search spec))) + + results)) + +;;; (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))) + +(defun* auth-source-netrc-create (&rest spec + &key backend + secret host user protocol create + &allow-other-keys) + (let* ((base-required '(host user protocol secret)) + ;; we know (because of an assertion in auth-source-search) that the + ;; :create parameter is either t or a list (which includes nil) + (create-extra (if (eq t create) nil create)) + (required (append base-required create-extra)) + (file (oref backend source)) + (add "") + ;; `valist' is an alist + valist) + + ;; 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 + (dolist (br base-required) + (when (symbol-value br) + (aput 'valist br (if (listp (symbol-value br)) + (nth 0 (symbol-value br)) + (symbol-value br))))) + + ;; for extra required elements, see if the spec includes a value for them + (dolist (er create-extra) + (let ((name (concat ":" (symbol-name er))) + (keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (dolist (k keys) + (when (equal (symbol-name k) name) + (aput 'valist er (plist-get spec k)))))) + + ;; for each required element + (dolist (r required) + (let* ((data (aget valist r)) + (given-default (aget auth-source-creation-defaults r)) + ;; the defaults are simple + (default (cond + ((and (not given-default) (eq r 'user)) + (user-login-name)) + ;; note we need this empty string + ((and (not given-default) (eq r 'protocol)) + "") + (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)) + (protocol-value (aget valist 'protocol)) + (info-so-far (concat (if user-value + (format "%s@" user-value) + "[USER?]") + (if host-value + (format "%s" host-value) + "[HOST?]") + (if protocol-value + ;; this distinguishes protocol between + (if (zerop (length protocol-value)) + "" ; 'entered as "no default"' vs. + (format ":%s" protocol-value)) ; given + ;; and this is when the protocol is unknown + "[PROTOCOL?]")))) + + ;; 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)))) + + ;; 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 + (cond + ((eq r 'user) "login") + ((eq r 'host) "machine") + ((eq r 'secret) "password") + ((eq r 'protocol) "port") + (t (symbol-name r))) + ;; the value will be printed in %S format + data)))))) + + (with-temp-buffer + (when (file-exists-p file) + (insert-file-contents file)) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + (goto-char (point-max)) + + ;; ask AFTER we've successfully opened the file + (when (y-or-n-p (format "Add to file %s: line [%s]" file add)) + (unless (bolp) + (insert "\n")) + (insert add "\n") + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-create: wrote 1 new line to %s" + file))))) + +;;; Backend specific parsing: Secrets API backend + +(defun* auth-source-secrets-search (&rest + spec + &key backend create + type max host user protocol + &allow-other-keys) + (debug spec)) + +(defun* auth-source-secrets-create (&rest + spec + &key backend type max host user protocol + &allow-other-keys) + (debug spec)) - (add-to-list 'choices choice 'append)))))) +;;; older API (defun auth-source-retrieve (mode entry &rest spec) "Retrieve MODE credentials according to SPEC from ENTRY." @@ -477,7 +1071,7 @@ MODE can be \"login\" or \"password\"." host protocol username) found) ; return the found data ;; else, if not found - (let ((choices (apply 'auth-source-pick search))) + (let ((choices (apply 'auth-source-search search))) (dolist (choice choices) (if delete-existing (apply 'auth-source-delete choice search) ----------------------------------------------------------------------- This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Gnus Project". The branch, tzz-auth-source-rewrite has been created hooks/post-receive -- Gnus Project