[gnus git] branch master updated: m0-7-81-g1474b92 =1= auth-source netrc backend: Support single-quoted strings, multiline entries.

Ted Zlatanov <[email protected]>
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  1474b920b7471e4bdb4f983b98fb767d61f8037b (commit)
      from  1ad6846b15e0cc71b89f2dc4851fedfe7222368c (commit)


- Log -----------------------------------------------------------------
commit 1474b920b7471e4bdb4f983b98fb767d61f8037b
Author: Ted Zlatanov <[email protected]>
Date:   Sat Jun 15 04:03:04 2013 -0400

    auth-source netrc backend: Support single-quoted strings, multiline entries.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 609beef..cd0b448 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2013-06-15  Teodor Zlatanov  <[email protected]>
+
+	* auth-source.el (auth-source-search-collection): Fix docstring.
+	(auth-source-netrc-parse): Refactor and improve netrc parser to support
+	single-quoted strings and multiline entries.
+	(auth-source-netrc-parse-next-interesting)
+	(auth-source-netrc-parse-one, auth-source-netrc-parse-entries): New
+	functions to support parser.
+
 2013-06-14  Lars Magne Ingebrigtsen  <[email protected]>
 
 	* eww.el (eww-submit): Get submit button logic right when hitting RET
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index f40d32a..c3eb6db 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -811,7 +811,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)))
 
@@ -952,7 +952,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,75 +965,13 @@ 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)
-
-          (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)
-            (auth-source--aput
-             auth-source-netrc-cache file
-             (list :mtime (nth 5 (file-attributes file))
-                   :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)))
-                   ((and (member elem tokens) (null pair))
-                    ;; 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)
+               (check (lambda(alist)
+                        (and alist
                        (auth-source-search-collection
                         host
                         (or
@@ -1056,22 +994,35 @@ Note that the MAX parameter is used so we can exit the parse early."
                        (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
+                              ;; 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 normalized req)))))
-              (decf max)
-              (push (nreverse alist) result)
-              ;; to delete a line, we just comment it out
-              (when delete
+                                      always (plist-get n req)))))))
+               result)
+
+          (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)
+            (auth-source--aput
+             auth-source-netrc-cache file
+             (list :mtime (nth 5 (file-attributes file))
+                   :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
+                             (lambda () (apply 'string (mapcar '1- v)))))))
                 (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 +1045,57 @@ 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)))
+
+(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")))
+        (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))
+          (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)))
+    (nreverse all)))
+
 (defvar auth-source-passphrase-alist nil)
 
 (defun auth-source-token-passphrase-callback-function (context key-id file)

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog      |    9 +++
 lisp/auth-source.el |  174 ++++++++++++++++++++++++++-------------------------
 2 files changed, 97 insertions(+), 86 deletions(-)

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, master has been updated


hooks/post-receive
-- 
Gnus Project
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.