commit 675a4e13cf14ff5bff61d06454269983844a8f91 (HEAD, refs/remotes/origin/master) Author: Ted Zlatanov Date: Tue Dec 19 20:01:08 2017 -0500 * lisp/auth-source.el (auth-source-backends-parser-file): Fix missing stringp. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 152c5af59a..e6582fa796 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -386,7 +386,8 @@ soon as a function returns non-nil.") (equal (file-name-extension source) "gpg")) (file-name-sans-extension source) (or source ""))) - (extension (or (file-name-extension source-without-gpg) + (extension (or (and (stringp source-without-gpg) + (file-name-extension source-without-gpg)) ""))) (when (stringp source) (cond commit 24efda1d28496d4eeadf794033f9d6f52b08f0e1 Author: Philipp Stephani Date: Tue Dec 19 00:00:31 2017 +0100 Use Jansson's error code support if available * src/json.c (json_parse_error): Use Jansson's error code support if available. diff --git a/src/json.c b/src/json.c index 47c5b8ff46..1c9bf6d49b 100644 --- a/src/json.c +++ b/src/json.c @@ -249,15 +249,24 @@ static _Noreturn void json_parse_error (const json_error_t *error) { Lisp_Object symbol; - /* FIXME: Upstream Jansson should have a way to return error codes - without parsing the error messages. See - https://github.com/akheron/jansson/issues/352. */ +#if JANSSON_VERSION_HEX >= 0x020B00 + switch (json_error_code (error)) + { + case json_error_premature_end_of_input: + symbol = Qjson_end_of_file; + case json_error_end_of_input_expected: + symbol = Qjson_trailing_content; + default: + symbol = Qjson_parse_error; + } +#else if (json_has_suffix (error->text, "expected near end of file")) symbol = Qjson_end_of_file; else if (json_has_prefix (error->text, "end of file expected")) symbol = Qjson_trailing_content; else symbol = Qjson_parse_error; +#endif xsignal (symbol, list5 (json_build_string (error->text), json_build_string (error->source), make_natnum (error->line), commit f946a198cb33d927c43a9eb5259f64d9effbfcdc Author: Glenn Morris Date: Tue Dec 19 15:10:34 2017 -0500 * doc/misc/auth.texi: Fix use of {} and wrapping in previous change. diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 16ce60199d..a5374a3b90 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -169,7 +169,8 @@ get fancy, the default and simplest configuration is: ;;; use pass (@file{~/.password-store}) ;;; (@pxref{The Unix password store}) (setq auth-sources '(password-store)) -;;; JSON data in format [{ "machine": "SERVER", "login": "USER", "password": "PASSWORD" }...] +;;; JSON data in format [@{ "machine": "SERVER", +;;; "login": "USER", "password": "PASSWORD" @}...] (setq auth-sources '("~/.authinfo.json.gpg")) @end lisp @@ -242,7 +243,8 @@ that sort of thing. Just point to a JSON file with entries like this: @example [ - { "machine": "yourmachine.com", "port": "http", "login": "testuser", "password": "testpass" } + @{ "machine": "yourmachine.com", "port": "http", + "login": "testuser", "password": "testpass" @} ] @end example commit db4f12e93f466832a5e5e1d512aff87ea90ef197 Author: Philipp Stephani Date: Wed Dec 13 23:35:07 2017 +0100 Allow JSON parser functions to return alists * src/json.c (Fjson_parse_string, Fjson_parse_buffer): Give these functions a keyword argument to specify the return type for JSON objects. (json_to_lisp): Convert objects to alists if requested. (json_parse_object_type): New helper function to parse keyword arguments. * test/src/json-tests.el (json-parse-string/object): Add a unit test. * doc/lispref/text.texi (Parsing JSON): Document new functionality. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 5b288d9750..9592702ef1 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4965,14 +4965,13 @@ represented using Lisp vectors. @item JSON has only one map type, the object. JSON objects are represented -using Lisp hashtables. +using Lisp hashtables or alists. @end itemize @noindent -Note that @code{nil} doesn't represent any JSON values: this is to -avoid confusion, because @code{nil} could either represent -@code{null}, @code{false}, or an empty array, all of which are +Note that @code{nil} represents the empty JSON object, @code{@{@}}, +not @code{null}, @code{false}, or an empty array, all of which are different JSON values. If some Lisp object can't be represented in JSON, the serialization @@ -4995,8 +4994,13 @@ The parsing functions will signal the following errors: Only top-level values (arrays and objects) can be serialized to JSON. The subobjects within these top-level values can be of any -type. Likewise, the parsing functions will only return vectors and -hashtables. +type. Likewise, the parsing functions will only return vectors, +hashtables, and alists. + + The parsing functions accept keyword arguments. Currently only one +keyword argument, @code{:object-type}, is recognized; its value can be +either @code{hash-table} to parse JSON objects as hashtables with +string keys (the default) or @code{alist} to parse them as alists. @defun json-serialize object This function returns a new Lisp string which contains the JSON @@ -5008,12 +5012,12 @@ This function inserts the JSON representation of @var{object} into the current buffer before point. @end defun -@defun json-parse-string string +@defun json-parse-string string &key (object-type @code{hash-table}) This function parses the JSON value in @var{string}, which must be a Lisp string. @end defun -@defun json-parse-buffer +@defun json-parse-buffer &key (object-type @code{hash-table}) This function reads the next JSON value from the current buffer, starting at point. It moves point to the position immediately after the value if a value could be read and converted to Lisp; otherwise it diff --git a/src/json.c b/src/json.c index 29e4400fc9..47c5b8ff46 100644 --- a/src/json.c +++ b/src/json.c @@ -518,10 +518,15 @@ OBJECT. */) return unbind_to (count, Qnil); } +enum json_object_type { + json_object_hashtable, + json_object_alist, +}; + /* Convert a JSON object to a Lisp object. */ static _GL_ARG_NONNULL ((1)) Lisp_Object -json_to_lisp (json_t *json) +json_to_lisp (json_t *json, enum json_object_type object_type) { switch (json_typeof (json)) { @@ -555,7 +560,7 @@ json_to_lisp (json_t *json) Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound); for (ptrdiff_t i = 0; i < size; ++i) ASET (result, i, - json_to_lisp (json_array_get (json, i))); + json_to_lisp (json_array_get (json, i), object_type)); --lisp_eval_depth; return result; } @@ -563,23 +568,49 @@ json_to_lisp (json_t *json) { if (++lisp_eval_depth > max_lisp_eval_depth) xsignal0 (Qjson_object_too_deep); - size_t size = json_object_size (json); - if (FIXNUM_OVERFLOW_P (size)) - xsignal0 (Qoverflow_error); - Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal, - QCsize, make_natnum (size)); - struct Lisp_Hash_Table *h = XHASH_TABLE (result); - const char *key_str; - json_t *value; - json_object_foreach (json, key_str, value) + Lisp_Object result; + switch (object_type) { - Lisp_Object key = json_build_string (key_str); - EMACS_UINT hash; - ptrdiff_t i = hash_lookup (h, key, &hash); - /* Keys in JSON objects are unique, so the key can't be - present yet. */ - eassert (i < 0); - hash_put (h, key, json_to_lisp (value), hash); + case json_object_hashtable: + { + size_t size = json_object_size (json); + if (FIXNUM_OVERFLOW_P (size)) + xsignal0 (Qoverflow_error); + result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize, + make_natnum (size)); + struct Lisp_Hash_Table *h = XHASH_TABLE (result); + const char *key_str; + json_t *value; + json_object_foreach (json, key_str, value) + { + Lisp_Object key = json_build_string (key_str); + EMACS_UINT hash; + ptrdiff_t i = hash_lookup (h, key, &hash); + /* Keys in JSON objects are unique, so the key can't + be present yet. */ + eassert (i < 0); + hash_put (h, key, json_to_lisp (value, object_type), hash); + } + break; + } + case json_object_alist: + { + result = Qnil; + const char *key_str; + json_t *value; + json_object_foreach (json, key_str, value) + { + Lisp_Object key = Fintern (json_build_string (key_str), Qnil); + result + = Fcons (Fcons (key, json_to_lisp (value, object_type)), + result); + } + result = Fnreverse (result); + break; + } + default: + /* Can't get here. */ + emacs_abort (); } --lisp_eval_depth; return result; @@ -589,15 +620,44 @@ json_to_lisp (json_t *json) emacs_abort (); } -DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, NULL, +static enum json_object_type +json_parse_object_type (ptrdiff_t nargs, Lisp_Object *args) +{ + switch (nargs) + { + case 0: + return json_object_hashtable; + case 2: + { + Lisp_Object key = args[0]; + Lisp_Object value = args[1]; + if (!EQ (key, QCobject_type)) + wrong_choice (list1 (QCobject_type), key); + if (EQ (value, Qhash_table)) + return json_object_hashtable; + else if (EQ (value, Qalist)) + return json_object_alist; + else + wrong_choice (list2 (Qhash_table, Qalist), value); + } + default: + wrong_type_argument (Qplistp, Flist (nargs, args)); + } +} + +DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, + NULL, doc: /* Parse the JSON STRING into a Lisp object. This is essentially the reverse operation of `json-serialize', which -see. The returned object will be a vector or hashtable. Its elements -will be `:null', `:false', t, numbers, strings, or further vectors and -hashtables. If there are duplicate keys in an object, all but the -last one are ignored. If STRING doesn't contain a valid JSON object, -an error of type `json-parse-error' is signaled. */) - (Lisp_Object string) +see. The returned object will be a vector, hashtable, or alist. Its +elements will be `:null', `:false', t, numbers, strings, or further +vectors, hashtables, and alists. If there are duplicate keys in an +object, all but the last one are ignored. If STRING doesn't contain a +valid JSON object, an error of type `json-parse-error' is signaled. +The keyword argument `:object-type' specifies which Lisp type is used +to represent objects; it can be `hash-table' or `alist'. +usage: (string &key (OBJECT-TYPE \\='hash-table)) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -616,8 +676,11 @@ an error of type `json-parse-error' is signaled. */) } #endif + Lisp_Object string = args[0]; Lisp_Object encoded = json_encode (string); check_string_without_embedded_nulls (encoded); + enum json_object_type object_type + = json_parse_object_type (nargs - 1, args + 1); json_error_t error; json_t *object = json_loads (SSDATA (encoded), 0, &error); @@ -628,7 +691,7 @@ an error of type `json-parse-error' is signaled. */) if (object != NULL) record_unwind_protect_ptr (json_release_object, object); - return unbind_to (count, json_to_lisp (object)); + return unbind_to (count, json_to_lisp (object, object_type)); } struct json_read_buffer_data @@ -661,12 +724,13 @@ json_read_buffer_callback (void *buffer, size_t buflen, void *data) } DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, - 0, 0, NULL, + 0, MANY, NULL, doc: /* Read JSON object from current buffer starting at point. This is similar to `json-parse-string', which see. Move point after the end of the object if parsing was successful. On error, point is -not moved. */) - (void) +not moved. +usage: (&key (OBJECT-TYPE \\='hash-table)) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -685,6 +749,8 @@ not moved. */) } #endif + enum json_object_type object_type = json_parse_object_type (nargs, args); + ptrdiff_t point = PT_BYTE; struct json_read_buffer_data data = {.point = point}; json_error_t error; @@ -698,7 +764,7 @@ not moved. */) record_unwind_protect_ptr (json_release_object, object); /* Convert and then move point only if everything succeeded. */ - Lisp_Object lisp = json_to_lisp (object); + Lisp_Object lisp = json_to_lisp (object, object_type); /* Adjust point by how much we just read. */ point += error.position; @@ -761,6 +827,9 @@ syms_of_json (void) Fput (Qjson_parse_string, Qpure, Qt); Fput (Qjson_parse_string, Qside_effect_free, Qt); + DEFSYM (QCobject_type, ":object-type"); + DEFSYM (Qalist, "alist"); + defsubr (&Sjson_serialize); defsubr (&Sjson_insert); defsubr (&Sjson_parse_string); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 551f8ac5fe..100bf7bd39 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -54,13 +54,15 @@ (ert-deftest json-parse-string/object () (skip-unless (fboundp 'json-parse-string)) - (let ((actual - (json-parse-string - "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))) - (should (hash-table-p actual)) - (should (equal (hash-table-count actual) 2)) - (should (equal (cl-sort (map-pairs actual) #'string< :key #'car) - '(("abc" . [9 :false]) ("def" . :null)))))) + (let ((input + "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")) + (let ((actual (json-parse-string input))) + (should (hash-table-p actual)) + (should (equal (hash-table-count actual) 2)) + (should (equal (cl-sort (map-pairs actual) #'string< :key #'car) + '(("abc" . [9 :false]) ("def" . :null))))) + (should (equal (json-parse-string input :object-type 'alist) + '((abc . [9 :false]) (def . :null)))))) (ert-deftest json-parse-string/string () (skip-unless (fboundp 'json-parse-string)) commit 16813e6faa32b1741685ee429132251846d253a3 Author: Ted Zlatanov Date: Tue Dec 19 11:44:26 2017 -0500 * doc/misc/auth.texi (Help for users): Mention JSON backend. diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index cfc62a9f92..16ce60199d 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -86,7 +86,7 @@ password (known as the secret). Similarly, the auth-source library supports multiple storage backend, currently either the classic ``netrc'' backend, examples of which you -can see later in this document, the Secret Service API, and pass, the +can see later in this document, JSON files, the Secret Service API, and pass, the standard unix password manager. This is done with EIEIO-based backends and you can write your own if you want. @@ -169,6 +169,8 @@ get fancy, the default and simplest configuration is: ;;; use pass (@file{~/.password-store}) ;;; (@pxref{The Unix password store}) (setq auth-sources '(password-store)) +;;; JSON data in format [{ "machine": "SERVER", "login": "USER", "password": "PASSWORD" }...] +(setq auth-sources '("~/.authinfo.json.gpg")) @end lisp By adding multiple entries to @code{auth-sources} with a particular @@ -235,6 +237,15 @@ don't use a port entry, you match any Tramp method, as explained earlier. Since Tramp has about 88 connection methods, this may be necessary if you have an unusual (see earlier comment on those) setup. +The netrc format is directly translated into JSON, if you are into +that sort of thing. Just point to a JSON file with entries like this: + +@example +[ + { "machine": "yourmachine.com", "port": "http", "login": "testuser", "password": "testpass" } +] +@end example + @node Multiple GMail accounts with Gnus @chapter Multiple GMail accounts with Gnus commit 1d0a37f845dbdebee81bed4c3c104e752c95c44c Author: Ted Zlatanov Date: Tue Dec 19 11:36:43 2017 -0500 auth-source: support JSON backend with .json extension * lisp/auth-source.el (auth-source-backends-parser-file): Look for .gpg extension and make backend decision without it. Add JSON case to backends. (auth-source-json-check): Parse JSON data. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 1cb7f5d57e..152c5af59a 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -379,24 +379,38 @@ soon as a function returns non-nil.") ;; take just a file name use it as a netrc/plist file ;; matching any user, host, and protocol (when (stringp entry) - (setq entry `(:source ,entry))) - (cond - ;; a file name with parameters - ((stringp (plist-get entry :source)) - (if (equal (file-name-extension (plist-get entry :source)) "plist") + (setq entry (list :source entry))) + (let* ((source (plist-get entry :source)) + (source-without-gpg + (if (and (stringp source) + (equal (file-name-extension source) "gpg")) + (file-name-sans-extension source) + (or source ""))) + (extension (or (file-name-extension source-without-gpg) + ""))) + (when (stringp source) + (cond + ((equal extension "plist") (auth-source-backend - (plist-get entry :source) - :source (plist-get entry :source) + source + :source source :type 'plstore :search-function #'auth-source-plstore-search :create-function #'auth-source-plstore-create - :data (plstore-open (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))))) + :data (plstore-open source))) + ((member-ignore-case extension '("json")) + (auth-source-backend + source + :source source + :type 'json + :search-function #'auth-source-json-search)) + (t + (auth-source-backend + source + :source source + :type 'netrc + :search-function #'auth-source-netrc-search + :create-function #'auth-source-netrc-create)))))) ;; Note this function should be last in the parser functions, so we add it first (add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-file) @@ -1967,6 +1981,77 @@ entries for git.gnus.org: (plstore-get-file (oref backend data)))) (plstore-save (oref backend data))))) +;;; Backend specific parsing: JSON backend +;;; (auth-source-search :max 1 :machine "imap.gmail.com") +;;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret)) + +(defun auth-source-json-check (host user port require item) + (and item + (auth-source-search-collection + (or host t) + (or + (plist-get item :machine) + (plist-get item :host) + t)) + (auth-source-search-collection + (or user t) + (or + (plist-get item :login) + (plist-get item :account) + (plist-get item :user) + t)) + (auth-source-search-collection + (or port t) + (or + (plist-get item :port) + (plist-get item :protocol) + t)) + (or + ;; the required list of keys is nil, or + (null require) + ;; every element of require is in + (cl-loop for req in require + always (plist-get item req))))) + +(cl-defun auth-source-json-search (&rest spec + &key backend require create + type max host user port + &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) + (cl-assert (or (null type) (eq type (oref backend type))) + t "Invalid JSON search: %s %s") + + ;; Hide the secrets early to avoid accidental exposure. + (let* ((jdata + (mapcar (lambda (entry) + (let (ret) + (while entry + (let* ((item (pop entry)) + (k (auth-source--symbol-keyword (car item))) + (v (cdr item))) + (setq k (cond ((memq k '(:machine)) :host) + ((memq k '(:login :account)) :user) + ((memq k '(:protocol)) :port) + ((memq k '(:password)) :secret) + (t k))) + ;; send back the secret in a function (lexical binding) + (when (eq k :secret) + (setq v (let ((lexv v)) + (lambda () lexv)))) + (setq ret (plist-put ret k v)))) + ret)) + (json-read-file (oref backend source)))) + (max (or max 5000)) ; sanity check: default to stop at 5K + all) + (dolist (item jdata) + (when (and item + (> max (length all)) + (auth-source-json-check host user port require item)) + (push item all))) + (nreverse all))) + ;;; older API ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")