gnus-request-head: when gnus-override-method is set, allow the backend

[gnus] / lisp / auth-source.el

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index ee608b3..46fba78 100644 (file)
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -264,6 +264,13 @@ can get pretty complex."
                   (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)
+
+                  (const :tag "Default generic Mac OS Keychain"
+                         'macos-keychain-generic)
+
                   (list :tag "Source definition"
                         (const :format "" :value :source)
                         (choice :tag "Authentication backend choice"
@@ -276,7 +283,21 @@ can get pretty complex."
                                          (const :tag "Default" 'default)
                                          (const :tag "Login" "Login")
                                          (const
-                                          :tag "Temporary" "session"))))
+                                          :tag "Temporary" "session")))
+                                (list
+                                 :tag "Mac OS internet Keychain"
+                                 (const :format ""
+                                        :value :macos-keychain-internet)
+                                 (choice :tag "Collection to use"
+                                         (string :tag "internet Keychain path")
+                                         (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))))
                         (repeat :tag "Extra Parameters" :inline t
                                 (choice :tag "Extra parameter"
                                         (list
@@ -387,6 +408,10 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
 ;; (auth-source-backend-parse "myfile.gpg")
 ;; (auth-source-backend-parse 'default)
 ;; (auth-source-backend-parse "secrets:Login")
+;; (auth-source-backend-parse 'macos-keychain-internet)
+;; (auth-source-backend-parse 'macos-keychain-generic)
+;; (auth-source-backend-parse "macos-keychain-internet:/path/here.keychain")
+;; (auth-source-backend-parse "macos-keychain-generic:/path/here.keychain")
 
 (defun auth-source-backend-parse (entry)
   "Creates an auth-source-backend from an ENTRY in `auth-sources'."
@@ -401,6 +426,28 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
     ;; matching any user, host, and protocol
     ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
      (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
+
+    ;; take 'macos-keychain-internet and recurse to get it as a Mac OS
+    ;; Keychain collection matching any user, host, and protocol
+    ((eq entry 'macos-keychain-internet)
+     (auth-source-backend-parse '(:source (:macos-keychain-internet default))))
+    ;; take 'macos-keychain-generic and recurse to get it as a Mac OS
+    ;; Keychain collection matching any user, host, and protocol
+    ((eq entry 'macos-keychain-generic)
+     (auth-source-backend-parse '(:source (:macos-keychain-generic default))))
+    ;; take macos-keychain-internet:XYZ and recurse to get it as MacOS
+    ;; Keychain "XYZ" matching any user, host, and protocol
+    ((and (stringp entry) (string-match "^macos-keychain-internet:\\(.+\\)"
+                                        entry))
+     (auth-source-backend-parse `(:source (:macos-keychain-internet
+                                           ,(match-string 1 entry)))))
+    ;; take macos-keychain-generic:XYZ and recurse to get it as MacOS
+    ;; Keychain "XYZ" matching any user, host, and protocol
+    ((and (stringp entry) (string-match "^macos-keychain-generic:\\(.+\\)"
+                                        entry))
+     (auth-source-backend-parse `(:source (:macos-keychain-generic
+                                           ,(match-string 1 entry)))))
+
     ;; take just a file name and recurse to get it as a netrc file
     ;; matching any user, host, and protocol
     ((stringp entry)
@@ -423,6 +470,33 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
         :search-function 'auth-source-netrc-search
         :create-function 'auth-source-netrc-create)))
 
+    ;; the MacOS Keychain
+    ((and
+      (not (null (plist-get entry :source))) ; the source must not be nil
+      (listp (plist-get entry :source))      ; and it must be a list
+      (or
+       (plist-get (plist-get entry :source) :macos-keychain-generic)
+       (plist-get (plist-get entry :source) :macos-keychain-internet)))
+
+     (let* ((source-spec (plist-get entry :source))
+            (keychain-generic (plist-get source-spec :macos-keychain-generic))
+            (keychain-type (if keychain-generic
+                               'macos-keychain-generic
+                             'macos-keychain-internet))
+            (source (plist-get source-spec (if keychain-generic
+                                               :macos-keychain-generic
+                                             :macos-keychain-internet))))
+
+       (when (symbolp source)
+         (setq source (symbol-name source)))
+
+       (auth-source-backend
+        (format "Mac OS Keychain (%s)" source)
+        :source source
+        :type keychain-type
+        :search-function 'auth-source-macos-keychain-search
+        :create-function 'auth-source-macos-keychain-create)))
+
     ;; the Secrets API.  We require the package, in order to have a
     ;; defined value for `secrets-enabled'.
     ((and
@@