keyring support

[Tom Tromey]

This code adds some simple keyring support to Emacs.  For the moment
this is just some lisp-level support for managing a keyring.  The .el
defines a simple API for managing a keyring, and a couple back ends:
an Emacs-specific keyring using GPG, and an interface to the Gnome
keyring (via the attached C program).

For best results I think the various parts of Emacs that ask for
passwords would have to be modified to use keyring.el.  Before looking
into that task, I thought I'd post the code here for comments.

Tom

;;; keyring.el --- Password management for Emacs

;; Copyright (C) 2007 Tom Tromey <address@hidden>

;; Author: Tom Tromey <address@hidden>
;; Created: 15 May 2007
;; Version: 0.1
;; Keywords: tools

;; This file is not (yet) part of GNU Emacs.
;; However, it is distributed under the same license.

;; 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 2, 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

;; FIXME: should be defcustom.
(defvar keyring-type 'gpg
  "Type of keyring to use, a symbol.
The default is `gpg', which uses an Emacs-specific format.
The value `gnome' is also supported if you have the `ekeyring' program.")



;;;; Gnome keyring handling.

(defvar keyring--gnome-program "ekeyring")

(defun keyring--call-process (program &rest args)
  (let (result)
    (condition-case nil
        (with-temp-buffer
          (apply 'call-process program nil t nil args)
          (setq result (buffer-substring-no-properties (point-min)
                                                       (point-max))))
      ((t (setq result nil))))
    result))

(defun keyring--get-password-gnome (alist)
  (let ((result
         (let (list)
           (mapc (lambda (elt)
                   (setq list (append (car elt) (cdr elt) list)))
                 alist)
           (keyring--call-process keyring--gnome-program "get"
                                  (nreverse list)))))
    (if (equal result "")
        nil
      result)))

(defun keyring--add-password-gnome (name alist secret)
  (let (list)
    (mapc (lambda (elt)
            (setq list (append (car elt) (cdr elt) list)))
          alist)
    (keyring--call-process keyring--gnome-program "set"
                           (nreverse list)
                           name secret)))



;;;; Emacs (GPG) keyring handling.

(defvar keyring--gpg-contents nil)

(defvar keyring--gpg-contents-read nil)

;; FIXME: should be defcustom.
(defvar keyring-gpg-file-name
  (expand-file-name (if (boundp 'user-emacs-directory)
                        (concat user-emacs-directory "keyring")
                      "~/.emacs.d/keyring"))
  "Name of the keyring file.
If you do not want to save the keyring, set this to nil.")

(defun keyring--gpg-load-contents ()
  (let ((name (and keyring-gpg-file-name
                   (expand-file-name keyring-gpg-file-name))))
    (if (and name (file-exists-p name))
        (with-temp-buffer
          (insert-file-contents-literally name)
          ;; FIXME: explicitly ask user for passphrase.
          (pgg-decrypt-region (point-min) (point-max))
          (let ((result (read (current-buffer))))
            ;; Check version number of data.
            (unless (eq (car result) 1)
              (error "Unknown version number in keyring: %d" (car result)))
            (setq keyring--gpg-contents (cdr result))))
      ;; No file.
      (setq keyring--gpg-contents '())))
  (setq keyring--gpg-contents-read t))

(defun keyring--get-password-gpg (alist)
  (unless keyring--gpg-contents-read
    (keyring--gpg-load-contents))
  (let ((contents keyring--gpg-contents)
        (result nil))
    (while (and contents (not result))
      (let ((iter alist)
            (ok t))
        ;; Check to see if each element in ALIST appears in one of the
        ;; alists in CONTENTS.
        (while iter
          (if (member (car iter) (car contents))
              (setq iter (cdr iter))
            (setq iter nil
                  ok nil)))
        (if ok
            (setq result (car contents))
          (setq contents (cdr contents)))))
    (if result
        (cdr (assq 'secret result)))))

(defun keyring--save ()
  (if keyring-gpg-file-name
      (with-temp-buffer
        (print (cons 1 keyring--gpg-contents) (current-buffer))
        (pgg-encrypt-symmetric-region (point-min) (point-max))
        (write-region nil nil
                      keyring-gpg-file-name nil 'nomessage))))

(defun keyring--add-password-gpg (name alist secret)
  (unless keyring--gpg-contents-read
    (keyring--gpg-load-contents))
  (setq keyring--gpg-contents
        (cons (append (list (cons 'name name) (cons 'secret secret)) alist)
              keyring--gpg-contents))
  (keyring--save))



;;;; Exported API.

(defun keyring--get-symbol (command)
  (intern (concat "keyring--" command "-password-" (symbol-name keyring-type))))

(defun keyring-get-password (prompt alist)
  "Retrieve a password, from the user or the keyring.
If the password is found in the keyring, it is returned.
Otherwise, the user is prompted for the password and a cons
of the form `(t . PASSWORD)' is returned.
To add a password to the keyring, see `keyring-add-password';
it is best to only call this if the password is correct.

ALIST is a an alist whose keys and values are strings.
These are used to identify the password in the keyring.
Typical entries are the protocol and the host."
  (let (result)
    (setq result (funcall (keyring--get-symbol "get") alist))
    (or result
        (cons t (read-passwd prompt)))))

(defun keyring-add-password (name alist secret)
  "Add a password to the keyring.
NAME is a user-readable name for the password.
ALIST is an alist, as in `keyring-get-password'.
SECRET is the password to add.
If the password already exists in the keyring, it is updated."
  (funcall (keyring--get-symbol "add") name alist secret))

(defun keyring-add-passwd-ask-user (name alist secret)
  ;; Maybe a variable to let the user always save?
  ;; Would be friendly to record which ones *not* to save, at least
  ;; for the duration of this session.
  (if (y-or-n-p (format "Save password for `%s'? " name))
      (keyring-add-passwd name alist secret)))

;;; keyring.el ends here