* etc/NEWS: Add secrets.el.
* lisp/Makefile.in (ELCFILES): Add net/secrets.elc. * lisp/net/secrets.el: New file.
This commit is contained in:
Michael Albinus
parent
cef3058fee
commit
7725ebb794
5 changed files with 707 additions and 0 deletions
|
|
@ -1,3 +1,7 @@
|
|||
2010-03-13 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* NEWS: Add secrets.el.
|
||||
|
||||
2010-03-12 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* images/custom/down.xpm, images/custom/right.xpm: Update images
|
||||
|
|
|
|||
4
etc/NEWS
4
etc/NEWS
|
|
@ -65,6 +65,10 @@ buffers.
|
|||
|
||||
* 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
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2010-03-13 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* Makefile.in (ELCFILES): Add net/secrets.elc.
|
||||
|
||||
* net/secrets.el: New file.
|
||||
|
||||
2010-03-12 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* facemenu.el (list-colors-display, list-colors-print): New arg
|
||||
|
|
|
|||
|
|
@ -1030,6 +1030,7 @@ ELCFILES = \
|
|||
$(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 \
|
||||
|
|
|
|||
692
lisp/net/secrets.el
Normal file
692
lisp/net/secrets.el
Normal file
|
|
@ -0,0 +1,692 @@
|
|||
;;; secrets.el --- Client interface to gnome-keyring and kwallet.
|
||||
|
||||
;; Copyright (C) 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Michael Albinus <michael.albinus@gmx.de>
|
||||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package provides an implementation of the Secret Service API
|
||||
;; <http://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
|
||||
;; 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.")
|
||||
|
||||
;; <interface name="org.freedesktop.Secret.Service">
|
||||
;; <property name="Collections" type="ao" access="read"/>
|
||||
;; <method name="OpenSession">
|
||||
;; <arg name="algorithm" type="s" direction="in"/>
|
||||
;; <arg name="input" type="v" direction="in"/>
|
||||
;; <arg name="output" type="v" direction="out"/>
|
||||
;; <arg name="result" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="CreateCollection">
|
||||
;; <arg name="props" type="a{sv}" direction="in"/>
|
||||
;; <arg name="collection" type="o" direction="out"/>
|
||||
;; <arg name="prompt" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="SearchItems">
|
||||
;; <arg name="attributes" type="a{ss}" direction="in"/>
|
||||
;; <arg name="unlocked" type="ao" direction="out"/>
|
||||
;; <arg name="locked" type="ao" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="Unlock">
|
||||
;; <arg name="objects" type="ao" direction="in"/>
|
||||
;; <arg name="unlocked" type="ao" direction="out"/>
|
||||
;; <arg name="prompt" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="Lock">
|
||||
;; <arg name="objects" type="ao" direction="in"/>
|
||||
;; <arg name="locked" type="ao" direction="out"/>
|
||||
;; <arg name="Prompt" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="GetSecrets">
|
||||
;; <arg name="items" type="ao" direction="in"/>
|
||||
;; <arg name="session" type="o" direction="in"/>
|
||||
;; <arg name="secrets" type="a{o(oayay)}" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="ReadAlias">
|
||||
;; <arg name="name" type="s" direction="in"/>
|
||||
;; <arg name="collection" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="SetAlias">
|
||||
;; <arg name="name" type="s" direction="in"/>
|
||||
;; <arg name="collection" type="o" direction="in"/>
|
||||
;; </method>
|
||||
;; <signal name="CollectionCreated">
|
||||
;; <arg name="collection" type="o"/>
|
||||
;; </signal>
|
||||
;; <signal name="CollectionDeleted">
|
||||
;; <arg name="collection" type="o"/>
|
||||
;; </signal>
|
||||
;; </interface>
|
||||
|
||||
(defconst secrets-interface-collection "org.freedesktop.Secret.Collection"
|
||||
"A collection of items containing secrets.")
|
||||
|
||||
;; <interface name="org.freedesktop.Secret.Collection">
|
||||
;; <property name="Items" type="ao" access="read"/>
|
||||
;; <property name="Label" type="s" access="readwrite"/>
|
||||
;; <property name="Locked" type="s" access="read"/>
|
||||
;; <property name="Created" type="t" access="read"/>
|
||||
;; <property name="Modified" type="t" access="read"/>
|
||||
;; <method name="Delete">
|
||||
;; <arg name="prompt" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="SearchItems">
|
||||
;; <arg name="attributes" type="a{ss}" direction="in"/>
|
||||
;; <arg name="results" type="ao" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="CreateItem">
|
||||
;; <arg name="props" type="a{sv}" direction="in"/>
|
||||
;; <arg name="secret" type="(oayay)" direction="in"/>
|
||||
;; <arg name="replace" type="b" direction="in"/>
|
||||
;; <arg name="item" type="o" direction="out"/>
|
||||
;; <arg name="prompt" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <signal name="ItemCreated">
|
||||
;; <arg name="item" type="o"/>
|
||||
;; </signal>
|
||||
;; <signal name="ItemDeleted">
|
||||
;; <arg name="item" type="o"/>
|
||||
;; </signal>
|
||||
;; <signal name="ItemChanged">
|
||||
;; <arg name="item" type="o"/>
|
||||
;; </signal>
|
||||
;; </interface>
|
||||
|
||||
(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.")
|
||||
|
||||
;; <interface name="org.freedesktop.Secret.Prompt">
|
||||
;; <method name="Prompt">
|
||||
;; <arg name="window-id" type="s" direction="in"/>
|
||||
;; </method>
|
||||
;; <method name="Dismiss"></method>
|
||||
;; <signal name="Completed">
|
||||
;; <arg name="dismissed" type="b"/>
|
||||
;; <arg name="result" type="v"/>
|
||||
;; </signal>
|
||||
;; </interface>
|
||||
|
||||
(defconst secrets-interface-item "org.freedesktop.Secret.Item"
|
||||
"A collection of items containing secrets.")
|
||||
|
||||
;; <interface name="org.freedesktop.Secret.Item">
|
||||
;; <property name="Locked" type="b" access="read"/>
|
||||
;; <property name="Attributes" type="a{ss}" access="readwrite"/>
|
||||
;; <property name="Label" type="s" access="readwrite"/>
|
||||
;; <property name="Created" type="t" access="read"/>
|
||||
;; <property name="Modified" type="t" access="read"/>
|
||||
;; <method name="Delete">
|
||||
;; <arg name="prompt" type="o" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="GetSecret">
|
||||
;; <arg name="session" type="o" direction="in"/>
|
||||
;; <arg name="secret" type="(oayay)" direction="out"/>
|
||||
;; </method>
|
||||
;; <method name="SetSecret">
|
||||
;; <arg name="secret" type="(oayay)" direction="in"/>
|
||||
;; </method>
|
||||
;; </interface>
|
||||
;;
|
||||
;; 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.")
|
||||
|
||||
;; <interface name="org.freedesktop.Secret.Session">
|
||||
;; <method name="Close"></method>
|
||||
;; </interface>
|
||||
|
||||
;;; 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.
|
||||
Loading…
Add table
Reference in a new issue