-(defvar mml2015-epg-secret-key-id-list nil)
-
-(defun mml2015-epg-passphrase-callback (context key-id ignore)
- (if (eq key-id 'SYM)
- (epg-passphrase-callback-function context key-id nil)
- (let* ((password-cache-key-id
- (if (eq key-id 'PIN)
- "PIN"
- key-id))
- entry
- (passphrase
- (password-read
- (if (eq key-id 'PIN)
- "Passphrase for PIN: "
- (if (setq entry (assoc key-id epg-user-id-alist))
- (format "Passphrase for %s %s: " key-id (cdr entry))
- (format "Passphrase for %s: " key-id)))
- password-cache-key-id)))
- (when passphrase
- (let ((password-cache-expiry mml2015-passphrase-cache-expiry))
- (password-cache-add password-cache-key-id passphrase))
- (setq mml2015-epg-secret-key-id-list
- (cons password-cache-key-id mml2015-epg-secret-key-id-list))
- (copy-sequence passphrase)))))
-
-(defun mml2015-epg-check-user-id (key recipient)
- (let ((pointer (epg-key-user-id-list key))
- result)
- (while pointer
- (if (and (equal (car (mail-header-parse-address
- (epg-user-id-string (car pointer))))
- (car (mail-header-parse-address
- recipient)))
- (not (memq (epg-user-id-validity (car pointer))
- '(revoked expired))))
- (setq result t
- pointer nil)
- (setq pointer (cdr pointer))))
- result))
-
-(defun mml2015-epg-check-sub-key (key usage)
- (let ((pointer (epg-key-sub-key-list key))
- result)
- ;; The primary key will be marked as disabled, when the entire
- ;; key is disabled (see 12 Field, Format of colon listings, in
- ;; gnupg/doc/DETAILS)
- (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
- (while pointer
- (if (and (memq usage (epg-sub-key-capability (car pointer)))
- (not (memq (epg-sub-key-validity (car pointer))
- '(revoked expired))))
- (setq result t
- pointer nil)
- (setq pointer (cdr pointer)))))
- result))
-
-(defun mml2015-epg-find-usable-key (context name usage
- &optional name-is-key-id)
- (let ((keys (epg-list-keys context name))
- key)
- (while keys
- (if (and (or name-is-key-id
- ;; Non email user-id can be supplied through
- ;; mml2015-signers if mml2015-encrypt-to-self is set.
- ;; Treat it as valid, as it is user's intention.
- (not (string-match "\\`<" name))
- (mml2015-epg-check-user-id (car keys) name))
- (mml2015-epg-check-sub-key (car keys) usage))
- (setq key (car keys)
- keys nil)
- (setq keys (cdr keys))))
- key))
-
-;; XXX: since gpg --list-secret-keys does not return validity of each
-;; key, `mml2015-epg-find-usable-key' defined above is not enough for
-;; secret keys. The function `mml2015-epg-find-usable-secret-key'
-;; below looks at appropriate public keys to check usability.
-(defun mml2015-epg-find-usable-secret-key (context name usage)
- (let ((secret-keys (epg-list-keys context name t))
- secret-key)
- (while (and (not secret-key) secret-keys)
- (if (mml2015-epg-find-usable-key
- context
- (epg-sub-key-fingerprint
- (car (epg-key-sub-key-list
- (car secret-keys))))
- usage
- t)
- (setq secret-key (car secret-keys)
- secret-keys nil)
- (setq secret-keys (cdr secret-keys))))
- secret-key))
-
-(autoload 'gnus-create-image "gnus-ems")
-