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
   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 ;;; Code:
  27
  28 (require 'epg)
  29 (eval-when-compile (require 'pgg))
  30
  31 (defvar pgg-epg-secret-key-id-list nil)
  32
  33 (defun pgg-epg-passphrase-callback (context key-id ignore)
  34   (if (eq key-id 'SYM)
  35       (epg-passphrase-callback-function context key-id nil)
  36     (let* ((entry (assoc key-id epg-user-id-alist))
  37            (passphrase
  38             (pgg-read-passphrase
  39              (format "GnuPG passphrase for %s: "
  40                      (if entry
  41                          (cdr entry)
  42                        key-id))
  43              (if (eq key-id 'PIN)
  44                  "PIN"
  45                key-id))))
  46       (when passphrase
  47         (pgg-add-passphrase-to-cache key-id passphrase)
  48         (setq pgg-epg-secret-key-id-list
  49               (cons key-id pgg-epg-secret-key-id-list))
  50         (copy-sequence passphrase)))))
  51
  52 (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase)
  53   "This function is for internal use only.
  54
  55 Encrypt the current region between START and END.
  56
  57 If optional argument SIGN is non-nil, do a combined sign and encrypt.
  58
  59 If optional PASSPHRASE is not specified, it will be obtained from the
  60 passphrase cache or user."
  61   (let ((context (epg-make-context))
  62         (inhibit-redisplay t)           ;Some Gnus users hate flickering
  63         cipher)
  64     (epg-context-set-armor context t)
  65     (epg-context-set-textmode context pgg-text-mode)
  66     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
  67     (get-buffer-create pgg-output-buffer)
  68     (get-buffer-create pgg-errors-buffer)
  69     (condition-case error
  70         (setq cipher
  71               (epg-encrypt-string context
  72                                   (buffer-substring start end)
  73                                   (mapcar
  74                                    (lambda (recipient)
  75                                      (car (epg-list-keys recipient)))
  76                                    (if pgg-encrypt-for-me
  77                                        (cons pgg-default-user-id recipients)
  78                                      recipients))
  79                                   sign t)
  80               pgg-epg-secret-key-id-list nil)
  81       (error
  82        (while pgg-epg-secret-key-id-list
  83          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
  84          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
  85        (signal (car error) (cdr error))))
  86     (save-excursion
  87       (set-buffer (get-buffer-create pgg-output-buffer))
  88       (erase-buffer)
  89       (insert cipher))
  90     t))
  91
  92 (defun pgg-epg-encrypt-symmetric-region (start end &optional passphrase)
  93   "This function is for internal use only.
  94
  95 Encrypt the current region between START and END with symmetric cipher.
  96
  97 If optional PASSPHRASE is not specified, it will be obtained from the
  98 passphrase cache or user."
  99   (pgg-epg-encrypt-region start end nil))
 100
 101 (defun pgg-epg-decrypt-region (start end &optional passphrase)
 102   "This function is for internal use only.
 103
 104 Decrypt the current region between START and END.
 105
 106 If optional PASSPHRASE is not specified, it will be obtained from the
 107 passphrase cache or user."
 108   (let ((context (epg-make-context))
 109         (inhibit-redisplay t)           ;Some Gnus users hate flickering
 110         plain)
 111     (epg-context-set-armor context t)
 112     (epg-context-set-textmode context pgg-text-mode)
 113     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
 114     (get-buffer-create pgg-output-buffer)
 115     (get-buffer-create pgg-errors-buffer)
 116     (condition-case error
 117         (setq plain (epg-decrypt-string context (buffer-substring start end))
 118               pgg-epg-secret-key-id-list nil)
 119       (error
 120        (while pgg-epg-secret-key-id-list
 121          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
 122          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
 123        (signal (car error) (cdr error))))
 124     (save-excursion
 125       (set-buffer (get-buffer-create pgg-output-buffer))
 126       (erase-buffer)
 127       (insert plain))
 128     t))
 129
 130 (defun pgg-epg-sign-region (start end &optional cleartext passphrase)
 131   "This function is for internal use only.
 132
 133 Make detached signature from text between START and END.
 134
 135 If optional PASSPHRASE is not specified, it will be obtained from the
 136 passphrase cache or user."
 137   (let ((context (epg-make-context))
 138         (inhibit-redisplay t)           ;Some Gnus users hate flickering
 139         signature)
 140     (epg-context-set-armor context t)
 141     (epg-context-set-textmode context pgg-text-mode)
 142     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
 143     (get-buffer-create pgg-output-buffer)
 144     (get-buffer-create pgg-errors-buffer)
 145     (condition-case error
 146         (setq signature
 147               (epg-sign-string context
 148                                (buffer-substring start end)
 149                                (if cleartext
 150                                    'clearsign
 151                                  'detached))
 152               pgg-epg-secret-key-id-list nil)
 153       (error
 154        (while pgg-epg-secret-key-id-list
 155          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
 156          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
 157        (signal (car error) (cdr error))))
 158     (save-excursion
 159       (set-buffer (get-buffer-create pgg-output-buffer))
 160       (erase-buffer)
 161       (insert signature))
 162     t))
 163
 164 (defvar pgg-epg-signatures nil)
 165
 166 (defun pgg-epg-verify-region (start end &optional signature)
 167   "This function is for internal use only.
 168
 169 Verify region between START and END as the detached signature SIGNATURE."
 170   (let ((context (epg-make-context))
 171         (inhibit-redisplay t))          ;Some Gnus users hate flickering
 172     (epg-context-set-armor context t)
 173     (epg-context-set-textmode context pgg-text-mode)
 174     (get-buffer-create pgg-output-buffer)
 175     (get-buffer-create pgg-errors-buffer)
 176     (if signature
 177         (epg-verify-string context
 178                            (with-temp-buffer
 179                              (insert-file-contents signature)
 180                              (buffer-string))
 181                            (buffer-substring start end))
 182       (epg-verify-string context (buffer-substring start end)))
 183     (save-excursion
 184       (set-buffer (get-buffer-create pgg-errors-buffer))
 185       (make-local-variable 'pgg-epg-signatures)
 186       (setq pgg-epg-signatures (epg-context-result-for context 'verify))
 187       (erase-buffer)
 188       (insert (epg-verify-result-to-string pgg-epg-signatures)))
 189     t))
 190
 191 (defun pgg-epg-insert-key ()
 192   "This function is for internal use only.
 193
 194 Insert public key at point."
 195   (let ((context (epg-make-context))
 196         (inhibit-redisplay t)           ;Some Gnus users hate flickering
 197         pointer)
 198     (epg-context-set-armor context t)
 199     (epg-context-set-textmode context pgg-text-mode)
 200     (insert (epg-export-keys context pgg-default-user-id))))
 201
 202 (defun pgg-epg-snarf-keys-region (start end)
 203   "This function is for internal use only.
 204
 205 Add all public keys in region between START and END to the keyring."
 206   (let ((context (epg-make-context))
 207         (inhibit-redisplay t)           ;Some Gnus users hate flickering
 208         pointer)
 209     (epg-context-set-armor context t)
 210     (epg-context-set-textmode context pgg-text-mode)
 211     (epg-import-keys context (buffer-substring start end))))
 212
 213 (defun mml2015-gpg-extract-signature-details ()
 214   (if pgg-epg-signatures
 215       (let* ((expired (eq (epg-signature-status (car pgg-epg-signatures))
 216                           'key-expired))
 217              (signer (cons (epg-signature-key-id (car pgg-epg-signatures))
 218                            (epg-signature-user-id (car pgg-epg-signatures))))
 219              (fprint (epg-signature-fingerprint (car pgg-epg-signatures)))
 220              (trust-good-enough-p
 221               (memq (epg-signature-validity (car pgg-epg-signatures))
 222                     '(marginal fully ultimate))))
 223         (cond ((and signer fprint)
 224                (concat (cdr signer)
 225                        (unless trust-good-enough-p
 226                          (concat "\nUntrusted, Fingerprint: "
 227                                  (mml2015-gpg-pretty-print-fpr fprint)))
 228                        (when expired
 229                          (format "\nWARNING: Signature from expired key (%s)"
 230                                  (car signer)))))
 231               (t
 232                "From unknown user")))
 233     "From unknown user"))
 234
 235 (provide 'pgg-epg)
 236
 237 ;;; pgg-epg.el ends here