Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 99665. ------------------------------------------------------------ revno: 99665 [merge] committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-03-15 01:39:53 +0000 message: (mm-charset-to-coding-system): Use coding-system-from-name if it is available. (bug#5647) diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-02-26 04:45:41 +0000 +++ lisp/gnus/ChangeLog 2010-03-15 01:38:28 +0000 @@ -1,3 +1,8 @@ +2010-03-15 Katsumi Yamaoka + + * mm-util.el (mm-charset-to-coding-system): Use coding-system-from-name + if it is available. (bug#5647) + 2010-02-26 Glenn Morris * message.el (message-send-mail-function): Change the default, so that === modified file 'lisp/gnus/mm-util.el' --- lisp/gnus/mm-util.el 2010-01-13 08:35:10 +0000 +++ lisp/gnus/mm-util.el 2010-03-15 01:38:28 +0000 @@ -566,6 +566,9 @@ ;;; (eq charset (coding-system-get charset 'mime-charset)) ) charset) + ;; Use coding system Emacs knows. + ((and (fboundp 'coding-system-from-name) + (coding-system-from-name charset))) ;; Eval expressions from `mm-charset-eval-alist' ((let* ((el (assq charset mm-charset-eval-alist)) (cs (car el)) ------------------------------------------------------------ revno: 99664 committer: Juri Linkov branch nick: trunk timestamp: Sun 2010-03-14 23:28:52 +0200 message: Add finder unknown keywords. * finder.el (finder-unknown-keywords): New function. * info.el (Info-finder-find-node): Use `finder-unknown-keywords' to create a Finder node with unknown keywords. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-03-14 21:15:02 +0000 +++ lisp/ChangeLog 2010-03-14 21:28:52 +0000 @@ -1,5 +1,14 @@ 2010-03-14 Juri Linkov + Add finder unknown keywords. + + * finder.el (finder-unknown-keywords): New function. + + * info.el (Info-finder-find-node): Use `finder-unknown-keywords' + to create a Finder node with unknown keywords. + +2010-03-14 Juri Linkov + * finder.el (finder-compile-keywords): Replace `princ' with `prin1' on a list of symbols interned from keyword strings. === modified file 'lisp/finder.el' --- lisp/finder.el 2010-03-14 21:15:02 +0000 +++ lisp/finder.el 2010-03-14 21:28:52 +0000 @@ -33,7 +33,6 @@ ;; there doesn't seem to be any way to get completing-read to exit on ;; an EOL with no substring pending, which is what we'd want to end the loop. ;; 2. Search by string in synopsis line? -;; 3. Function to check finder-package-info for unknown keywords. ;;; Code: @@ -230,6 +229,29 @@ '(mouse-face highlight help-echo finder-help-echo)))) +(defun finder-unknown-keywords () + "Return an alist of unknown keywords and number of their occurences. +Unknown are keywords that are present in `finder-package-info' +but absent in `finder-known-keywords'." + (let ((unknown-keywords-hash (make-hash-table))) + ;; Prepare a hash where key is a keyword + ;; and value is the number of keyword occurences. + (mapc (lambda (package) + (mapc (lambda (keyword) + (unless (assq keyword finder-known-keywords) + (puthash keyword + (1+ (gethash keyword unknown-keywords-hash 0)) + unknown-keywords-hash))) + (nth 2 package))) + finder-package-info) + ;; Make an alist from the hash and sort by the keyword name. + (sort (let (unknown-keywords-list) + (maphash (lambda (key value) + (push (cons key value) unknown-keywords-list)) + unknown-keywords-hash) + unknown-keywords-list) + (lambda (a b) (string< (car a) (car b)))))) + ;;;###autoload (defun finder-list-keywords () "Display descriptions of the keywords in the Finder buffer." === modified file 'lisp/info.el' --- lisp/info.el 2010-03-03 19:23:20 +0000 +++ lisp/info.el 2010-03-14 21:28:52 +0000 @@ -3343,6 +3343,7 @@ (defvar finder-known-keywords) (defvar finder-package-info) (declare-function find-library-name "find-func" (library)) +(declare-function finder-unknown-keywords "finder" ()) (declare-function lm-commentary "lisp-mnt" (&optional file)) (defun Info-finder-find-node (filename nodename &optional no-going-back) @@ -3361,7 +3362,21 @@ (insert (format "* %-14s %s.\n" (concat (symbol-name keyword) "::") (cdr assoc))))) - finder-known-keywords)) + (cons '(unknown . "unknown keywords") + finder-known-keywords))) + ((equal nodename "unknown") + ;; Display unknown keywords + (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" + Info-finder-file nodename)) + (insert "Finder Unknown Keywords\n") + (insert "***********************\n\n") + (insert "* Menu:\n\n") + (mapc + (lambda (assoc) + (insert (format "* %-14s %s.\n" + (concat (symbol-name (car assoc)) "::") + (cdr assoc)))) + (finder-unknown-keywords))) ((string-match-p "\\.el\\'" nodename) ;; Display commentary section (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" ------------------------------------------------------------ revno: 99663 committer: Juri Linkov branch nick: trunk timestamp: Sun 2010-03-14 23:15:02 +0200 message: Fix keywords. * finder.el (finder-compile-keywords): Replace `princ' with `prin1' on a list of symbols interned from keyword strings. * emacs-lisp/lisp-mnt.el (lm-keywords-list): If `keywords' contains a comma, then split keywords using a comma and optional whitespace. Otherwise, split by whitespace. * complete.el: * face-remap.el: * log-view.el: * net/hmac-def.el: * net/hmac-md5.el: * net/netrc.el: * progmodes/mixal-mode.el: Fix keywords. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-03-13 20:33:54 +0000 +++ lisp/ChangeLog 2010-03-14 21:15:02 +0000 @@ -1,3 +1,20 @@ +2010-03-14 Juri Linkov + + * finder.el (finder-compile-keywords): Replace `princ' with + `prin1' on a list of symbols interned from keyword strings. + + * emacs-lisp/lisp-mnt.el (lm-keywords-list): If `keywords' contains + a comma, then split keywords using a comma and optional whitespace. + Otherwise, split by whitespace. + + * complete.el: + * face-remap.el: + * log-view.el: + * net/hmac-def.el: + * net/hmac-md5.el: + * net/netrc.el: + * progmodes/mixal-mode.el: Fix keywords. + 2010-03-13 Michael Albinus * Makefile.in (ELCFILES): Add net/secrets.elc. === modified file 'lisp/complete.el' --- lisp/complete.el 2010-01-13 08:35:10 +0000 +++ lisp/complete.el 2010-03-14 21:15:02 +0000 @@ -5,6 +5,7 @@ ;; Author: Dave Gillespie ;; Keywords: abbrev convenience +;; ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. ;; This file is part of GNU Emacs. === modified file 'lisp/emacs-lisp/lisp-mnt.el' --- lisp/emacs-lisp/lisp-mnt.el 2010-01-13 08:35:10 +0000 +++ lisp/emacs-lisp/lisp-mnt.el 2010-03-14 21:15:02 +0000 @@ -458,7 +458,9 @@ "Return list of keywords given in file FILE." (let ((keywords (lm-keywords file))) (if keywords - (split-string keywords "[, \t\n]+" t)))) + (if (string-match-p "," keywords) + (split-string keywords ",[ \t\n]*" t) + (split-string keywords "[ \t\n]+" t))))) (defvar finder-known-keywords) (defun lm-keywords-finder-p (&optional file) === modified file 'lisp/face-remap.el' --- lisp/face-remap.el 2010-01-13 08:35:10 +0000 +++ lisp/face-remap.el 2010-03-14 21:15:02 +0000 @@ -3,7 +3,7 @@ ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Miles Bader -;; Keywords: faces face remapping display user commands +;; Keywords: faces, face remapping, display, user commands ;; ;; This file is part of GNU Emacs. ;; === modified file 'lisp/finder.el' --- lisp/finder.el 2010-01-13 08:35:10 +0000 +++ lisp/finder.el 2010-03-14 21:15:02 +0000 @@ -182,7 +182,7 @@ f))) (prin1 summary (current-buffer)) (insert "\n ") - (princ keywords (current-buffer)) + (prin1 (mapcar 'intern keywords) (current-buffer)) (insert ")\n"))) (directory-files d nil ;; Allow compressed files also. FIXME: === modified file 'lisp/log-view.el' --- lisp/log-view.el 2010-03-12 08:04:54 +0000 +++ lisp/log-view.el 2010-03-14 21:15:02 +0000 @@ -4,7 +4,7 @@ ;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Keywords: rcs sccs cvs log version-control tools +;; Keywords: rcs, sccs, cvs, log, version control, tools ;; This file is part of GNU Emacs. === modified file 'lisp/net/hmac-def.el' --- lisp/net/hmac-def.el 2010-03-08 17:14:53 +0000 +++ lisp/net/hmac-def.el 2010-03-14 21:15:02 +0000 @@ -3,7 +3,7 @@ ;; Copyright (C) 1999, 2001, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI -;; Keywords: HMAC, RFC-2104 +;; Keywords: HMAC, RFC2104 ;; This file is part of GNU Emacs. @@ -22,7 +22,7 @@ ;;; Commentary: -;; This program is implemented from RFC 2104, +;; This program is implemented from RFC2104, ;; "HMAC: Keyed-Hashing for Message Authentication". ;;; Code: === modified file 'lisp/net/hmac-md5.el' --- lisp/net/hmac-md5.el 2010-03-08 17:14:53 +0000 +++ lisp/net/hmac-md5.el 2010-03-14 21:15:02 +0000 @@ -3,7 +3,7 @@ ;; Copyright (C) 1999, 2001, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI -;; Keywords: HMAC, RFC-2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 +;; Keywords: HMAC, RFC2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 ;; This file is part of GNU Emacs. === modified file 'lisp/net/netrc.el' --- lisp/net/netrc.el 2010-01-13 08:35:10 +0000 +++ lisp/net/netrc.el 2010-03-14 21:15:02 +0000 @@ -4,6 +4,7 @@ ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news +;; ;; Modularized by Ted Zlatanov ;; when it was part of Gnus. === modified file 'lisp/progmodes/mixal-mode.el' --- lisp/progmodes/mixal-mode.el 2010-01-13 08:35:10 +0000 +++ lisp/progmodes/mixal-mode.el 2010-03-14 21:15:02 +0000 @@ -7,7 +7,7 @@ ;; Maintainer: Pieter E.J. Pareit ;; Created: 09 Nov 2002 ;; Version: 0.1 -;; Keywords: languages Knuth mix mixal asm mixvm "The Art Of Computer Programming" +;; Keywords: languages, Knuth, mix, mixal, asm, mixvm, The Art Of Computer Programming ;; This file is part of GNU Emacs. ------------------------------------------------------------ revno: 99662 committer: Michael Albinus branch nick: trunk timestamp: Sat 2010-03-13 21:33:54 +0100 message: * etc/NEWS: Add secrets.el. * lisp/Makefile.in (ELCFILES): Add net/secrets.elc. * lisp/net/secrets.el: New file. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2010-03-12 21:42:05 +0000 +++ etc/ChangeLog 2010-03-13 20:33:54 +0000 @@ -1,3 +1,7 @@ +2010-03-13 Michael Albinus + + * NEWS: Add secrets.el. + 2010-03-12 Chong Yidong * images/custom/down.xpm, images/custom/right.xpm: Update images === modified file 'etc/NEWS' --- etc/NEWS 2010-03-12 23:13:27 +0000 +++ etc/NEWS 2010-03-13 20:33:54 +0000 @@ -65,6 +65,10 @@ * New Modes and Packages in Emacs 24.1 +** secrets.el is an implementation of the Secret Service API, an +interface to password managers like GNOME Keyring or KDE Wallet. The +Secret Service API requires D-Bus for communication. + * Incompatible Lisp Changes in Emacs 24.1 === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-03-12 23:08:30 +0000 +++ lisp/ChangeLog 2010-03-13 20:33:54 +0000 @@ -1,3 +1,9 @@ +2010-03-13 Michael Albinus + + * Makefile.in (ELCFILES): Add net/secrets.elc. + + * net/secrets.el: New file. + 2010-03-12 Chong Yidong * facemenu.el (list-colors-display, list-colors-print): New arg === modified file 'lisp/Makefile.in' --- lisp/Makefile.in 2010-01-13 08:35:10 +0000 +++ lisp/Makefile.in 2010-03-13 20:33:54 +0000 @@ -1030,6 +1030,7 @@ $(lisp)/net/sasl-digest.elc \ $(lisp)/net/sasl-ntlm.elc \ $(lisp)/net/sasl.elc \ + $(lisp)/net/secrets.elc \ $(lisp)/net/snmp-mode.elc \ $(lisp)/net/socks.elc \ $(lisp)/net/telnet.elc \ === added file 'lisp/net/secrets.el' --- lisp/net/secrets.el 1970-01-01 00:00:00 +0000 +++ lisp/net/secrets.el 2010-03-13 20:33:54 +0000 @@ -0,0 +1,692 @@ +;;; secrets.el --- Client interface to gnome-keyring and kwallet. + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Michael Albinus +;; Keywords: comm password passphrase + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package provides an implementation of the Secret Service API +;; . +;; This API is meant to make GNOME-Keyring- and KWallet-like daemons +;; available under a common D-BUS interface and thus increase +;; interoperability between GNOME, KDE and other applications having +;; the need to securely store passwords and other confidential +;; information. + +;; In order to activate this package, you must add the following code +;; into your .emacs: + +;; (require 'secrets) + +;; The atomic objects to be managed by the Secret Service API are +;; secret items, which are something an application wishes to store +;; securely. A good example is a password that an application needs +;; to save and use at a later date. + +;; Secret items are grouped in collections. A collection is similar +;; in concept to the terms 'keyring' or 'wallet'. A common collection +;; is called "login". A collection is stored permanently under the +;; user's permissions, and can be accessed in a user session context. + +;; A collection can have an alias name. The use case for this is to +;; set the alias "default" for a given collection, making it +;; transparent for clients, which collection is used. Other aliases +;; are not supported (yet). Since an alias is visible to all +;; applications, this setting shall be performed with care. + +;; A list of all available collections is available by +;; +;; (secrets-list-collections) +;; => ("session" "login" "ssh keys") + +;; The "default" alias could be set to the "login" collection by +;; +;; (secrets-set-alias "login" "default") + +;; An alias can also be dereferenced +;; +;; (secrets-get-alias "default") +;; => "login" + +;; Collections can be created and deleted. As already said, +;; collections are used by different applications. Therefore, those +;; operations shall also be performed with care. Common collections, +;; like "login", shall not be changed except adding or deleting secret +;; items. +;; +;; (secrets-delete-collection "my collection") +;; (secrets-create-collection "my collection") + +;; There exists a special collection called "session", which has the +;; lifetime of the corrresponding client session (aka Emacs' +;; lifetime). It is created automatically when Emacs uses the Secret +;; Service interface, and it is deleted when Emacs is killed. +;; Therefore, it can be used to store and retrieve secret items +;; temporarily. This shall be preferred over creation of a persistent +;; collection, when the information shall not live longer than Emacs. +;; The session collection can be addressed either by the string +;; "session", or by `nil', whenever a collection parameter is needed. + +;; As already said, a collection is a group of secret items. A secret +;; item has a label, the "secret" (which is a string), and a set of +;; lookup attributes. The attributes can be used to search and +;; retrieve a secret item at a later date. + +;; A list of all available secret items of a collection is available by +;; +;; (secrets-list-items "my collection") +;; => ("this item" "another item") + +;; Secret items can be added or deleted to a collection. In the +;; following examples, we use the special collection "session", which +;; is bound to Emacs' lifetime. +;; +;; (secrets-delete-item "session" "my item") +;; (secrets-create-item "session" "my item" "geheim" +;; :user "joe" :host "remote-host") + +;; The string "geheim" is the secret of the secret item "my item". +;; The secret string can be retrieved from items: +;; +;; (secrets-get-secret "session" "my item") +;; => "geheim" + +;; The lookup attributes, which are specified during creation of a +;; secret item, must be a key-value pair. Keys are keyword symbols, +;; starting with a colon; values are strings. They can be retrieved +;; from a given secret item: +;; +;; (secrets-get-attribute "session" "my item" :host) +;; => "remote-host" +;; +;; (secrets-get-attributes "session" "my item") +;; => ((:user . "joe") (:host ."remote-host")) + +;; The lookup attributes can be used for searching of items. If you, +;; for example, are looking for all secret items for the user "joe", +;; you would perform +;; +;; (secrets-search-items "session" :user "joe") +;; => ("my item" "another item") + +;;; Code: + +;; It has been tested with GNOME Keyring 2.29.92. An implementation +;; for KWallet will be available at +;; svn://anonsvn.kde.org/home/kde/trunk/playground/base/ksecretservice; +;; not tested yet. + +;; Pacify byte-compiler. D-Bus support in the Emacs core can be +;; disabled with configuration option "--without-dbus". Declare used +;; subroutines and variables of `dbus' therefore. +(eval-when-compile + (require 'cl)) + +(declare-function dbus-call-method "dbusbind.c") +(declare-function dbus-register-signal "dbusbind.c") +(defvar dbus-debug) + +(require 'dbus) + +(defvar secrets-debug t + "Write debug messages") + +(defconst secrets-service "org.freedesktop.secrets" + "The D-Bus name used to talk to Secret Service.") + +(defconst secrets-path "/org/freedesktop/secrets" + "The D-Bus root object path used to talk to Secret Service.") + +(defconst secrets-empty-path "/" + "The D-Bus object path representing an empty object.") + +(defsubst secrets-empty-path (path) + "Check, whether PATH is a valid object path. +It returns t if not." + (or (not (stringp path)) + (string-equal path secrets-empty-path))) + +(defconst secrets-interface-service "org.freedesktop.Secret.Service" + "The D-Bus interface managing sessions and collections.") + +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; + +(defconst secrets-interface-collection "org.freedesktop.Secret.Collection" + "A collection of items containing secrets.") + +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; + +(defconst secrets-session-collection-path + "/org/freedesktop/secrets/collection/session" + "The D-Bus temporary session collection object path.") + +(defconst secrets-interface-prompt "org.freedesktop.Secret.Prompt" + "A session tracks state between the service and a client application.") + +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; + +(defconst secrets-interface-item "org.freedesktop.Secret.Item" + "A collection of items containing secrets.") + +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; STRUCT secret +;; OBJECT PATH session +;; ARRAY BYTE parameters +;; ARRAY BYTE value + +(defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic" + "The default item type we are using.") + +(defconst secrets-interface-session "org.freedesktop.Secret.Session" + "A session tracks state between the service and a client application.") + +;; +;; +;; + +;;; Sessions. + +(defvar secrets-session-path secrets-empty-path + "The D-Bus session path of the active session. +A session path `secrets-empty-path' indicates there is no open session.") + +(defun secrets-close-session () + "Close the secret service session, if any." + (dbus-ignore-errors + (dbus-call-method + :session secrets-service secrets-session-path + secrets-interface-session "Close")) + (setq secrets-session-path secrets-empty-path)) + +(defun secrets-open-session (&optional reopen) + "Open a new session with \"plain\" algorithm. +If there exists another active session, and REOPEN is nil, that +session will be used. The object path of the session will be +returned, and it will be stored in `secrets-session-path'." + (when reopen (secrets-close-session)) + (when (secrets-empty-path secrets-session-path) + (setq secrets-session-path + (cadr + (dbus-call-method + :session secrets-service secrets-path + secrets-interface-service "OpenSession" "plain" '(:variant ""))))) + (when secrets-debug + (message "Secret Service session: %s" secrets-session-path)) + secrets-session-path) + +;;; Prompts. + +(defvar secrets-prompt-signal nil + "Internal variable to catch signals from `secrets-interface-prompt'.") + +(defun secrets-prompt (prompt) + "Handle the prompt identified by object path PROMPT." + (unless (secrets-empty-path prompt) + (let ((object + (dbus-register-signal + :session secrets-service prompt + secrets-interface-prompt "Completed" 'secrets-prompt-handler))) + (dbus-call-method + :session secrets-service prompt + secrets-interface-prompt "Prompt" (frame-parameter nil 'window-id)) + (unwind-protect + (progn + ;; Wait until the returned prompt signal has put the + ;; result into `secrets-prompt-signal'. + (while (null secrets-prompt-signal) + (read-event nil nil 0.1)) + ;; Return the object(s). It is a variant, so we must use a car. + (car secrets-prompt-signal)) + ;; Cleanup. + (setq secrets-prompt-signal nil) + (dbus-unregister-object object))))) + +(defun secrets-prompt-handler (&rest args) + "Handler for signals emitted by `secrets-interface-prompt'." + ;; An empty object path is always identified as `secrets-empty-path' + ;; or `nil'. Either we set it explicitely, or it is returned by the + ;; "Completed" signal. + (if (car args) ;; dismissed + (setq secrets-prompt-signal (list secrets-empty-path)) + (setq secrets-prompt-signal (cadr args)))) + +;;; Collections. + +(defvar secrets-collection-paths nil + "Cached D-Bus object paths of available collections.") + +(defun secrets-collection-handler (&rest args) + "Handler for signals emitted by `secrets-interface-service'." + (cond + ((string-equal (dbus-event-member-name last-input-event) "CollectionCreated") + (add-to-list 'secrets-collection-paths (car args))) + ((string-equal (dbus-event-member-name last-input-event) "CollectionDeleted") + (setq secrets-collection-paths + (delete (car args) secrets-collection-paths))))) + +(dbus-register-signal + :session secrets-service secrets-path + secrets-interface-service "CollectionCreated" 'secrets-collection-handler) + +(dbus-register-signal + :session secrets-service secrets-path + secrets-interface-service "CollectionDeleted" 'secrets-collection-handler) + +(defun secrets-get-collections () + "Return the object paths of all available collections." + (setq secrets-collection-paths + (or secrets-collection-paths + (dbus-get-property + :session secrets-service secrets-path + secrets-interface-service "Collections")))) + +(defun secrets-get-collection-properties (collection-path) + "Return all properties of collection identified by COLLECTION-PATH." + (unless (secrets-empty-path collection-path) + (dbus-get-all-properties + :session secrets-service collection-path + secrets-interface-collection))) + +(defun secrets-get-collection-property (collection-path property) + "Return property PROPERTY of collection identified by COLLECTION-PATH." + (unless (or (secrets-empty-path collection-path) (not (stringp property))) + (dbus-get-property + :session secrets-service collection-path + secrets-interface-collection property))) + +(defun secrets-list-collections () + "Return a list of collection names." + (mapcar + (lambda (collection-path) + (if (string-equal collection-path secrets-session-collection-path) + "session" + (secrets-get-collection-property collection-path "Label"))) + (secrets-get-collections))) + +(defun secrets-collection-path (collection) + "Return the object path of collection labelled COLLECTION. +If COLLECTION is nil, return the session collection path. +If there is no such COLLECTION, return nil." + (or + ;; The "session" collection. + (if (or (null collection) (string-equal "session" collection)) + secrets-session-collection-path) + ;; Check for an alias. + (let ((collection-path + (dbus-call-method + :session secrets-service secrets-path + secrets-interface-service "ReadAlias" collection))) + (unless (secrets-empty-path collection-path) + collection-path)) + ;; Check the collections. + (catch 'collection-found + (dolist (collection-path (secrets-get-collections) nil) + (when + (string-equal + collection + (secrets-get-collection-property collection-path "Label")) + (throw 'collection-found collection-path)))))) + +(defun secrets-create-collection (collection) + "Create collection labelled COLLECTION if it doesn't exist. +Return the D-Bus object path for collection." + (let ((collection-path (secrets-collection-path collection))) + ;; Create the collection. + (when (secrets-empty-path collection-path) + (setq collection-path + (secrets-prompt + (cadr + ;; "CreateCollection" returns the prompt path as second arg. + (dbus-call-method + :session secrets-service secrets-path + secrets-interface-service "CreateCollection" + `(:array (:dict-entry "Label" (:variant ,collection)))))))) + ;; Return object path of the collection. + collection-path)) + +(defun secrets-get-alias (alias) + "Return the collection name ALIAS is referencing to. +For the time being, only the alias \"default\" is supported." + (secrets-get-collection-property + (dbus-call-method + :session secrets-service secrets-path + secrets-interface-service "ReadAlias" alias) + "Label")) + +(defun secrets-set-alias (collection alias) + "Set ALIAS as alias of collection labelled COLLECTION. +For the time being, only the alias \"default\" is supported." + (let ((collection-path (secrets-collection-path collection))) + (unless (secrets-empty-path collection-path) + (dbus-call-method + :session secrets-service secrets-path + secrets-interface-service "SetAlias" + alias :object-path collection-path)))) + +(defun secrets-unlock-collection (collection) + "Unlock collection labelled COLLECTION. +If successful, return the object path of the collection." + (let ((collection-path (secrets-collection-path collection))) + (unless (secrets-empty-path collection-path) + (secrets-prompt + (cadr + (dbus-call-method + :session secrets-service secrets-path secrets-interface-service + "Unlock" `(:array :object-path ,collection-path))))) + collection-path)) + +(defun secrets-delete-collection (collection) + "Delete collection labelled COLLECTION." + (let ((collection-path (secrets-collection-path collection))) + (unless (secrets-empty-path collection-path) + (secrets-prompt + (dbus-call-method + :session secrets-service collection-path + secrets-interface-collection "Delete"))))) + +;;; Items. + +(defun secrets-get-items (collection-path) + "Return the object paths of all available items in COLLECTION-PATH." + (unless (secrets-empty-path collection-path) + (secrets-open-session) + (dbus-get-property + :session secrets-service collection-path + secrets-interface-collection "Items"))) + +(defun secrets-get-item-properties (item-path) + "Return all properties of item identified by ITEM-PATH." + (unless (secrets-empty-path item-path) + (dbus-get-all-properties + :session secrets-service item-path + secrets-interface-item))) + +(defun secrets-get-item-property (item-path property) + "Return property PROPERTY of item identified by ITEM-PATH." + (unless (or (secrets-empty-path item-path) (not (stringp property))) + (dbus-get-property + :session secrets-service item-path + secrets-interface-item property))) + +(defun secrets-list-items (collection) + "Return a list of all item labels of COLLECTION." + (let ((collection-path (secrets-unlock-collection collection))) + (unless (secrets-empty-path collection-path) + (mapcar + (lambda (item-path) + (secrets-get-item-property item-path "Label")) + (secrets-get-items collection-path))))) + +(defun secrets-search-items (collection &rest attributes) + "Search items in COLLECTION with ATTRIBUTES. +ATTRIBUTES are key-value pairs. The keys are keyword symbols, +starting with a colon. Example: + + \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\" + :method \"sudo\" :user \"joe\" :host \"remote-host\"\) + +The object paths of the found items are returned as list." + (let ((collection-path (secrets-unlock-collection collection)) + result props) + (unless (secrets-empty-path collection-path) + ;; Create attributes list. + (while (consp (cdr attributes)) + (unless (keywordp (car attributes)) + (error 'wrong-type-argument (car attributes))) + (setq props (add-to-list + 'props + (list :dict-entry + (symbol-name (car attributes)) + (cadr attributes)) + 'append) + attributes (cddr attributes))) + ;; Search. The result is a list of two lists, the object paths + ;; of the unlocked and the locked items. + (setq result + (dbus-call-method + :session secrets-service collection-path + secrets-interface-collection "SearchItems" + (if props + (cons :array props) + '(:array :signature "{ss}")))) + ;; Return the found items. + (mapcar + (lambda (item-path) (secrets-get-item-property item-path "Label")) + (append (car result) (cadr result)))))) + +(defun secrets-create-item (collection item password &rest attributes) + "Create a new item in COLLECTION with label ITEM and password PASSWORD. +ATTRIBUTES are key-value pairs set for the created item. The +keys are keyword symbols, starting with a colon. Example: + + \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\" + :method \"sudo\" :user \"joe\" :host \"remote-host\"\) + +The object path of the created item is returned." + (unless (member item (secrets-list-items collection)) + (let ((collection-path (secrets-unlock-collection collection)) + result props) + (unless (secrets-empty-path collection-path) + ;; Create attributes list. + (while (consp (cdr attributes)) + (unless (keywordp (car attributes)) + (error 'wrong-type-argument (car attributes))) + (setq props (add-to-list + 'props + (list :dict-entry + (symbol-name (car attributes)) + (cadr attributes)) + 'append) + attributes (cddr attributes))) + ;; Create the item. + (setq result + (dbus-call-method + :session secrets-service collection-path + secrets-interface-collection "CreateItem" + ;; Properties. + (append + `(:array + (:dict-entry "Label" (:variant ,item)) + (:dict-entry + "Type" (:variant ,secrets-interface-item-type-generic))) + (when props + `((:dict-entry + "Attributes" (:variant ,(append '(:array) props)))))) + ;; Secret. + `(:struct :object-path ,secrets-session-path + (:array :signature "y") ;; no parameters. + ,(dbus-string-to-byte-array password)) + ;; Do not replace. Replace does not seem to work. + nil)) + (secrets-prompt (cadr result)) + ;; Return the object path. + (car result))))) + +(defun secrets-item-path (collection item) + "Return the object path of item labelled ITEM in COLLECTION. +If there is no such item, return nil." + (let ((collection-path (secrets-unlock-collection collection))) + (catch 'item-found + (dolist (item-path (secrets-get-items collection-path)) + (when (string-equal item (secrets-get-item-property item-path "Label")) + (throw 'item-found item-path)))))) + +(defun secrets-get-secret (collection item) + "Return the secret of item labelled ITEM in COLLECTION. +If there is no such item, return nil." + (let ((item-path (secrets-item-path collection item))) + (unless (secrets-empty-path item-path) + (dbus-byte-array-to-string + (caddr + (dbus-call-method + :session secrets-service item-path secrets-interface-item + "GetSecret" :object-path secrets-session-path)))))) + +(defun secrets-get-attributes (collection item) + "Return the lookup attributes of item labelled ITEM in COLLECTION. +If there is no such item, or the item has no attributes, return nil." + (unless (stringp collection) (setq collection "default")) + (let ((item-path (secrets-item-path collection item))) + (unless (secrets-empty-path item-path) + (mapcar + (lambda (attribute) (cons (intern (car attribute)) (cadr attribute))) + (dbus-get-property + :session secrets-service item-path + secrets-interface-item "Attributes"))))) + +(defun secrets-get-attribute (collection item attribute) + "Return the value of ATTRIBUTE of item labelled ITEM in COLLECTION. +If there is no such item, or the item doesn't own this attribute, return nil." + (cdr (assoc attribute (secrets-get-attributes collection item)))) + +(defun secrets-delete-item (collection item) + "Delete ITEM in COLLECTION." + (let ((item-path (secrets-item-path collection item))) + (unless (secrets-empty-path item-path) + (secrets-prompt + (dbus-call-method + :session secrets-service item-path + secrets-interface-item "Delete"))))) + +;; We must reset all variables, when there is a new instance of the +;; "org.freedesktop.secrets" service. + +(dbus-register-signal + :session dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "NameOwnerChanged" + (lambda (&rest args) + (when secrets-debug (message "Secret Service has changed: %S" args)) + (setq secrets-session-path secrets-empty-path + secrets-prompt-signal nil + secrets-collection-paths nil)) + secrets-service) + +(provide 'secrets) + +;;; TODO: + +;; * secrets-debug should be structured like auth-source-debug to +;; prevent leaking sensitive information. Right now I don't see +;; anything sensitive though. +;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be +;; used for the transfer of the secrets. Currently, we use the +;; plain algorithm. ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.