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