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