[Emacs-diffs] trunk r113001: lisp/gnus/auth-source.el (netrc backend): Support single-quoted strings, multiline entries

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 113001
revision-id: address@hidden
parent: address@hidden
author: Ted Zlatanov <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Sat 2013-06-15 21:59:59 +0000
message:
  lisp/gnus/auth-source.el (netrc backend): Support single-quoted strings, 
multiline entries
modified:
  lisp/gnus/ChangeLog            changelog-20091113204419-o5vbwnq5f7feedwu-1433
  lisp/gnus/auth-source.el       
authsource.el-20091113204419-o5vbwnq5f7feedwu-8608

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2013-06-14 11:16:26 +0000
+++ b/lisp/gnus/ChangeLog       2013-06-15 21:59:59 +0000
@@ -1,3 +1,12 @@
+2013-06-15  Teodor Zlatanov  <address@hidden>
+
+       * 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  <address@hidden>
 
        * eww.el (eww-submit): Get submit button logic right when hitting RET

=== modified file 'lisp/gnus/auth-source.el'
--- a/lisp/gnus/auth-source.el  2013-02-07 06:23:54 +0000
+++ b/lisp/gnus/auth-source.el  2013-06-15 21:59:59 +0000
@@ -801,7 +801,7 @@
   (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)))
 
@@ -942,7 +942,7 @@
 (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
@@ -955,15 +955,41 @@
     (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
@@ -983,85 +1009,10 @@
                    :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)
-                       (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
@@ -1084,6 +1035,57 @@
 
           (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)