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