;;; secrets.el --- Client interface to gnome-keyring and kwallet.
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm password passphrase
;; into your .emacs:
;;
;; (require 'secrets)
-
-;; It can be checked afterwards, whether there is a daemon providing
-;; this interface:
;;
-;; (featurep 'secrets 'enabled)
+;; Afterwards, the variable `secrets-enabled' is non-nil when there is
+;; a daemon providing this interface.
;; The atomic objects to be managed by the Secret Service API are
;; secret items, which are something an application wishes to store
;; (secrets-search-items "session" :user "joe")
;; => ("my item" "another item")
+;; Interactively, collections, items and their attributes could be
+;; inspected by the command `secrets-show-secrets'.
+
;;; Code:
;; It has been tested with GNOME Keyring 2.29.92. An implementation
(require 'dbus)
+(autoload 'tree-widget-set-theme "tree-widget")
+(autoload 'widget-create-child-and-convert "wid-edit")
+(autoload 'widget-default-value-set "wid-edit")
+(autoload 'widget-field-end "wid-edit")
+(autoload 'widget-member "wid-edit")
+(defvar tree-widget-after-toggle-functions)
+
+(defvar secrets-enabled nil
+ "Whether there is a daemon offering the Secret Service API.")
+
(defvar secrets-debug t
"Write debug messages")
;; Check the collections.
(catch 'collection-found
(dolist (collection-path (secrets-get-collections) nil)
- (when
- (string-equal
- collection
- (secrets-get-collection-property collection-path "Label"))
+ (when (string-equal
+ collection
+ (secrets-get-collection-property collection-path "Label"))
(throw 'collection-found collection-path))))))
(defun secrets-create-collection (collection)
secrets-interface-service "SetAlias"
alias :object-path collection-path))))
+(defun secrets-delete-alias (alias)
+ "Delete ALIAS, referencing to a collection."
+ (dbus-call-method
+ :session secrets-service secrets-path
+ secrets-interface-service "SetAlias"
+ alias :object-path secrets-empty-path))
+
(defun secrets-unlock-collection (collection)
"Unlock collection labelled COLLECTION.
If successful, return the object path of the collection."
(setq props (add-to-list
'props
(list :dict-entry
- (symbol-name (car attributes))
+ (substring (symbol-name (car attributes)) 1)
(cadr attributes))
'append)
attributes (cddr attributes)))
(setq props (add-to-list
'props
(list :dict-entry
- (symbol-name (car attributes))
+ (substring (symbol-name (car attributes)) 1)
(cadr attributes))
'append)
attributes (cddr attributes)))
(let ((item-path (secrets-item-path collection item)))
(unless (secrets-empty-path item-path)
(mapcar
- (lambda (attribute) (cons (intern (car attribute)) (cadr attribute)))
+ (lambda (attribute)
+ (cons (intern (concat ":" (car attribute))) (cadr attribute)))
(dbus-get-property
:session secrets-service item-path
secrets-interface-item "Attributes")))))
:session secrets-service item-path
secrets-interface-item "Delete")))))
-(if (dbus-ping :session secrets-service 100)
-
- (progn
- ;; 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)
-
- ;; We want to refresh our cache, when there is a change in
- ;; collections.
- (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)
-
- ;; We shall inform, whether the secret service is enabled on
- ;; this machine.
- (provide 'secrets '(enabled)))
-
- (provide 'secrets))
+;;; Visualization.
+
+(define-derived-mode secrets-mode nil "Secrets"
+ "Major mode for presenting password entries retrieved by Security Service.
+In this mode, widgets represent the search results.
+
+\\{secrets-mode-map}"
+ ;; Keymap.
+ (setq secrets-mode-map (copy-keymap special-mode-map))
+ (set-keymap-parent secrets-mode-map widget-keymap)
+ (define-key secrets-mode-map "z" 'kill-this-buffer)
+
+ ;; When we toggle, we must set temporary widgets.
+ (set (make-local-variable 'tree-widget-after-toggle-functions)
+ '(secrets-tree-widget-after-toggle-function))
+
+ (when (not (called-interactively-p 'interactive))
+ ;; Initialize buffer.
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
+
+;; It doesn't make sense to call it interactively.
+(put 'secrets-mode 'disabled t)
+
+;; The very first buffer created with `secrets-mode' does not have the
+;; keymap etc. So we create a dummy buffer. Stupid.
+(with-temp-buffer (secrets-mode))
+
+;; We autoload `secrets-show-secrets' only on systems with D-Bus support.
+;;;###autoload(when (featurep 'dbusbind)
+;;;###autoload (autoload 'secrets-show-secrets "secrets" nil t))
+
+(defun secrets-show-secrets ()
+ "Display a list of collections from the Secret Service API.
+The collections are in tree view, that means they can be expanded
+to the corresponding secret items, which could also be expanded
+to their attributes."
+ (interactive)
+
+ ;; Check, whether the Secret Service API is enabled.
+ (if (null secrets-enabled)
+ (message "Secret Service not available")
+
+ ;; Create the search buffer.
+ (with-current-buffer (get-buffer-create "*Secrets*")
+ (switch-to-buffer-other-window (current-buffer))
+ ;; Inialize buffer with `secrets-mode'.
+ (secrets-mode)
+ (secrets-show-collections))))
+
+(defun secrets-show-collections ()
+ "Show all available collections."
+ (let ((inhibit-read-only t)
+ (alias (secrets-get-alias "default")))
+ (erase-buffer)
+ (tree-widget-set-theme "folder")
+ (dolist (coll (secrets-list-collections))
+ (widget-create
+ `(tree-widget
+ :tag ,coll
+ :collection ,coll
+ :open nil
+ :sample-face bold
+ :expander secrets-expand-collection)))))
+
+(defun secrets-expand-collection (widget)
+ "Expand items of collection shown as WIDGET."
+ (let ((coll (widget-get widget :collection)))
+ (mapcar
+ (lambda (item)
+ `(tree-widget
+ :tag ,item
+ :collection ,coll
+ :item ,item
+ :open nil
+ :sample-face bold
+ :expander secrets-expand-item))
+ (secrets-list-items coll))))
+
+(defun secrets-expand-item (widget)
+ "Expand password and attributes of item shown as WIDGET."
+ (let* ((coll (widget-get widget :collection))
+ (item (widget-get widget :item))
+ (attributes (secrets-get-attributes coll item))
+ ;; padding is needed to format attribute names.
+ (padding
+ (apply
+ 'max
+ (cons
+ (1+ (length "password"))
+ (mapcar
+ ;; Atribute names have a leading ":", which will be suppressed.
+ (lambda (attribute) (length (symbol-name (car attribute))))
+ attributes)))))
+ (cons
+ ;; The password widget.
+ `(editable-field :tag "password"
+ :secret ?*
+ :value ,(secrets-get-secret coll item)
+ :sample-face widget-button-pressed
+ ;; We specify :size in order to limit the field.
+ :size 0
+ :format ,(concat
+ "%{%t%}:"
+ (make-string (- padding (length "password")) ? )
+ "%v\n"))
+ (mapcar
+ (lambda (attribute)
+ (let ((name (substring (symbol-name (car attribute)) 1))
+ (value (cdr attribute)))
+ ;; The attribute widget.
+ `(editable-field :tag ,name
+ :value ,value
+ :sample-face widget-documentation
+ ;; We specify :size in order to limit the field.
+ :size 0
+ :format ,(concat
+ "%{%t%}:"
+ (make-string (- padding (length name)) ? )
+ "%v\n"))))
+ attributes))))
+
+(defun secrets-tree-widget-after-toggle-function (widget &rest ignore)
+ "Add a temporary widget to show the password."
+ (dolist (child (widget-get widget :children))
+ (when (widget-member child :secret)
+ (goto-char (widget-field-end child))
+ (widget-insert " ")
+ (widget-create-child-and-convert
+ child 'push-button
+ :notify 'secrets-tree-widget-show-password
+ "Show password")))
+ (widget-setup))
+
+(defun secrets-tree-widget-show-password (widget &rest ignore)
+ "Show password, and remove temporary widget."
+ (let ((parent (widget-get widget :parent)))
+ (widget-put parent :secret nil)
+ (widget-default-value-set parent (widget-get parent :value))
+ (widget-setup)))
+
+;;; Initialization.
+
+(when (dbus-ping :session secrets-service 100)
+
+ ;; 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)
+
+ ;; We want to refresh our cache, when there is a change in
+ ;; collections.
+ (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)
+
+ ;; We shall inform, whether the secret service is enabled on this
+ ;; machine.
+ (setq secrets-enabled t))
+
+(provide 'secrets)
;;; TODO:
HCoop / bpt / emacs.git / blobdiff