pgg-epg.el

   1 ;;; pgg-epg.el --- Gnus' PGG backend of EasyPG.
   2 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
   3 ;;   2005, 2006 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2006 Daiki Ueno
   5
   6 ;; Author: Daiki Ueno <ueno@unixuser.org>
   7 ;; Keywords: PGP, GnuPG, Gnus
   8
   9 ;; This file is part of EasyPG.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; To use, add (setq pgg-scheme 'epg) to your ~/.gnus.
  29
  30 ;;; Code:
  31
  32 (require 'epa)
  33 (eval-when-compile (require 'pgg))
  34
  35 (defvar pgg-epg-secret-key-id-list nil)
  36
  37 (defun pgg-epg-passphrase-callback (context key-id ignore)
  38   (if (eq key-id 'SYM)
  39       (epa-passphrase-callback-function context key-id nil)
  40     (let* ((entry (assoc key-id epg-user-id-alist))
  41            (passphrase
  42             (pgg-read-passphrase
  43              (format "GnuPG passphrase for %s: "
  44                      (if entry
  45                          (cdr entry)
  46                        key-id))
  47              (if (eq key-id 'PIN)
  48                  "PIN"
  49                key-id))))
  50       (when passphrase
  51         (pgg-add-passphrase-to-cache key-id passphrase)
  52         (setq pgg-epg-secret-key-id-list
  53               (cons key-id pgg-epg-secret-key-id-list))
  54         (copy-sequence passphrase)))))
  55
  56 (defvar inhibit-redisplay)
  57 (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase)
  58   "This function is for internal use only.
  59
  60 Encrypt the current region between START and END.
  61
  62 If optional argument SIGN is non-nil, do a combined sign and encrypt.
  63
  64 If optional PASSPHRASE is not specified, it will be obtained from the
  65 passphrase cache or user."
  66   (let ((context (epg-make-context))
  67         (inhibit-redisplay t)           ;Gnus users don't like flickering
  68         cipher)
  69     (epg-context-set-armor context t)
  70     (epg-context-set-textmode context pgg-text-mode)
  71     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
  72     (save-excursion
  73       (set-buffer (get-buffer-create pgg-output-buffer))
  74       (erase-buffer)
  75       (set-buffer (get-buffer-create pgg-errors-buffer))
  76       (erase-buffer))
  77     (condition-case error
  78         (setq cipher
  79               (epg-encrypt-string context
  80                                   (buffer-substring start end)
  81                                   (mapcar
  82                                    (lambda (recipient)
  83                                      (car (epg-list-keys context recipient)))
  84                                    (if pgg-encrypt-for-me
  85                                        (cons pgg-default-user-id recipients)
  86                                      recipients))
  87                                   sign t)
  88               pgg-epg-secret-key-id-list nil)
  89       (error
  90        (while pgg-epg-secret-key-id-list
  91          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
  92          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
  93        (signal (car error) (cdr error))))
  94     (save-excursion
  95       (set-buffer (get-buffer-create pgg-output-buffer))
  96       (insert cipher))
  97     t))
  98
  99 (defun pgg-epg-encrypt-symmetric-region (start end &optional passphrase)
 100   "This function is for internal use only.
 101
 102 Encrypt the current region between START and END with symmetric cipher.
 103
 104 If optional PASSPHRASE is not specified, it will be obtained from the
 105 passphrase cache or user."
 106   (pgg-epg-encrypt-region start end nil))
 107
 108 (defun pgg-epg-decrypt-region (start end &optional passphrase)
 109   "This function is for internal use only.
 110
 111 Decrypt the current region between START and END.
 112
 113 If optional PASSPHRASE is not specified, it will be obtained from the
 114 passphrase cache or user."
 115   (let ((context (epg-make-context))
 116         (inhibit-redisplay t)           ;Gnus users don't like flickering
 117         plain)
 118     (epg-context-set-armor context t)
 119     (epg-context-set-textmode context pgg-text-mode)
 120     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
 121     (save-excursion
 122       (set-buffer (get-buffer-create pgg-output-buffer))
 123       (erase-buffer)
 124       (set-buffer (get-buffer-create pgg-errors-buffer))
 125       (erase-buffer))
 126     (condition-case error
 127         (setq plain
 128               (epg-decrypt-string context (buffer-substring start end))
 129               pgg-epg-secret-key-id-list nil)
 130       (error
 131        (while pgg-epg-secret-key-id-list
 132          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
 133          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
 134        (signal (car error) (cdr error))))
 135     (if (and pgg-text-mode
 136              (fboundp 'decode-coding-string))
 137         (setq plain (decode-coding-string plain 'raw-text)))
 138     (save-excursion
 139       (set-buffer (get-buffer-create pgg-output-buffer))
 140       (insert plain))
 141     t))
 142
 143 (defun pgg-epg-sign-region (start end &optional cleartext passphrase)
 144   "This function is for internal use only.
 145
 146 Make detached signature from text between START and END.
 147
 148 If optional PASSPHRASE is not specified, it will be obtained from the
 149 passphrase cache or user."
 150   (let ((context (epg-make-context))
 151         (inhibit-redisplay t)           ;Gnus users don't like flickering
 152         signature)
 153     (epg-context-set-armor context t)
 154     (epg-context-set-textmode context pgg-text-mode)
 155     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
 156     (epg-context-set-signers
 157      context
 158      (list (car (epg-list-keys context pgg-default-user-id t))))
 159     (save-excursion
 160       (set-buffer (get-buffer-create pgg-output-buffer))
 161       (erase-buffer)
 162       (set-buffer (get-buffer-create pgg-errors-buffer))
 163       (erase-buffer))
 164     (condition-case error
 165         (setq signature
 166               (epg-sign-string context
 167                                (buffer-substring start end)
 168                                (if cleartext
 169                                    'clear
 170                                  'detached))
 171               pgg-epg-secret-key-id-list nil)
 172       (error
 173        (while pgg-epg-secret-key-id-list
 174          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
 175          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
 176        (signal (car error) (cdr error))))
 177     (save-excursion
 178       (set-buffer (get-buffer-create pgg-output-buffer))
 179       (insert signature))
 180     t))
 181
 182 (defvar pgg-epg-signatures nil)
 183
 184 (defun pgg-epg-verify-region (start end &optional signature)
 185   "This function is for internal use only.
 186
 187 Verify region between START and END as the detached signature SIGNATURE."
 188   (let ((context (epg-make-context))
 189         (inhibit-redisplay t))          ;Gnus users don't like flickering
 190     (epg-context-set-armor context t)
 191     (epg-context-set-textmode context pgg-text-mode)
 192     (save-excursion
 193       (set-buffer (get-buffer-create pgg-output-buffer))
 194       (erase-buffer)
 195       (set-buffer (get-buffer-create pgg-errors-buffer))
 196       (erase-buffer))
 197     (if signature
 198         (epg-verify-string context
 199                            (with-temp-buffer
 200                              (insert-file-contents signature)
 201                              (buffer-string))
 202                            (buffer-substring start end))
 203       (epg-verify-string context (buffer-substring start end)))
 204     (save-excursion
 205       (set-buffer (get-buffer-create pgg-errors-buffer))
 206       (make-local-variable 'pgg-epg-signatures)
 207       (setq pgg-epg-signatures (epg-context-result-for context 'verify))
 208       (insert (epg-verify-result-to-string pgg-epg-signatures)))
 209     t))
 210
 211 (defun pgg-epg-insert-key ()
 212   "This function is for internal use only.
 213
 214 Insert public key at point."
 215   (let ((context (epg-make-context))
 216         (inhibit-redisplay t)           ;Gnus users don't like flickering
 217         )
 218     (epg-context-set-armor context t)
 219     (epg-context-set-textmode context pgg-text-mode)
 220     (save-excursion
 221       (set-buffer (get-buffer-create pgg-output-buffer))
 222       (erase-buffer)
 223       (set-buffer (get-buffer-create pgg-errors-buffer))
 224       (erase-buffer))
 225     (insert (epg-export-keys-to-string context pgg-default-user-id))))
 226
 227 (defun pgg-epg-snarf-keys-region (start end)
 228   "This function is for internal use only.
 229
 230 Add all public keys in region between START and END to the keyring."
 231   (let ((context (epg-make-context))
 232         (inhibit-redisplay t)           ;Gnus users don't like flickering
 233         )
 234     (epg-context-set-armor context t)
 235     (epg-context-set-textmode context pgg-text-mode)
 236     (save-excursion
 237       (set-buffer (get-buffer-create pgg-output-buffer))
 238       (erase-buffer)
 239       (set-buffer (get-buffer-create pgg-errors-buffer))
 240       (erase-buffer))
 241     (epg-import-keys-from-string context (buffer-substring start end))))
 242
 243 (eval-when-compile
 244   (autoload 'mml2015-gpg-pretty-print-fpr "mml2015"))
 245 (defun mml2015-gpg-extract-signature-details ()
 246   (if pgg-epg-signatures
 247       (let* ((expired (eq (epg-signature-status (car pgg-epg-signatures))
 248                           'key-expired))
 249              (signer (cons (epg-signature-key-id (car pgg-epg-signatures))
 250                            (cdr (assoc (epg-signature-key-id
 251                                         (car pgg-epg-signatures))
 252                                        epg-user-id-alist))))
 253              (fprint (epg-signature-fingerprint (car pgg-epg-signatures)))
 254              (trust-good-enough-p
 255               (memq (epg-signature-validity (car pgg-epg-signatures))
 256                     '(marginal full ultimate))))
 257         (cond ((and signer fprint)
 258                (concat (cdr signer)
 259                        (unless trust-good-enough-p
 260                          (concat "\nUntrusted, Fingerprint: "
 261                                  (mml2015-gpg-pretty-print-fpr fprint)))
 262                        (when expired
 263                          (format "\nWARNING: Signature from expired key (%s)"
 264                                  (car signer)))))
 265               (t
 266                "From unknown user")))
 267     "From unknown user"))
 268
 269 (defun pgg-epg-lookup-key (string &optional type)
 270   "Search keys associated with STRING."
 271   (mapcar (lambda (key)
 272             (epg-sub-key-id (car (epg-key-sub-key-list key))))
 273           (epg-list-keys (epg-make-context) string (not (null type)))))
 274
 275 (provide 'pgg-epg)
 276
 277 ;;; pgg-epg.el ends here