# HG changeset patch # User Michael Albinus # Date 1268512434 -3600 # Node ID 51ddd70d1fa10a768299a8a26180502bafbd9439 # Parent 969a1a50d14cb32ce51fc55bcff511ef571453ce * etc/NEWS: Add secrets.el. * lisp/Makefile.in (ELCFILES): Add net/secrets.elc. * lisp/net/secrets.el: New file. diff -r 969a1a50d14c -r 51ddd70d1fa1 etc/ChangeLog --- a/etc/ChangeLog Sat Mar 13 14:54:29 2010 -0500 +++ b/etc/ChangeLog Sat Mar 13 21:33:54 2010 +0100 @@ -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 diff -r 969a1a50d14c -r 51ddd70d1fa1 etc/NEWS --- a/etc/NEWS Sat Mar 13 14:54:29 2010 -0500 +++ b/etc/NEWS Sat Mar 13 21:33:54 2010 +0100 @@ -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 diff -r 969a1a50d14c -r 51ddd70d1fa1 lisp/ChangeLog --- a/lisp/ChangeLog Sat Mar 13 14:54:29 2010 -0500 +++ b/lisp/ChangeLog Sat Mar 13 21:33:54 2010 +0100 @@ -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 diff -r 969a1a50d14c -r 51ddd70d1fa1 lisp/Makefile.in --- a/lisp/Makefile.in Sat Mar 13 14:54:29 2010 -0500 +++ b/lisp/Makefile.in Sat Mar 13 21:33:54 2010 +0100 @@ -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 \ diff -r 969a1a50d14c -r 51ddd70d1fa1 lisp/net/secrets.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/secrets.el Sat Mar 13 21:33:54 2010 +0100 @@ -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.