LCOV - code coverage report
Current view: top level - lisp - epg.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 2 1311 0.2 %
Date: 2017-08-27 09:44:50 Functions: 1 133 0.8 %

          Line data    Source code
       1             : ;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
       2             : ;; Copyright (C) 1999-2000, 2002-2017 Free Software Foundation, Inc.
       3             : 
       4             : ;; Author: Daiki Ueno <ueno@unixuser.org>
       5             : ;; Keywords: PGP, GnuPG
       6             : ;; Version: 1.0.0
       7             : 
       8             : ;; This file is part of GNU Emacs.
       9             : 
      10             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      11             : ;; it under the terms of the GNU General Public License as published by
      12             : ;; the Free Software Foundation, either version 3 of the License, or
      13             : ;; (at your option) any later version.
      14             : 
      15             : ;; GNU Emacs is distributed in the hope that it will be useful,
      16             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      17             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      18             : ;; GNU General Public License for more details.
      19             : 
      20             : ;; You should have received a copy of the GNU General Public License
      21             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      22             : 
      23             : ;;; Code:
      24             : 
      25             : (require 'epg-config)
      26             : (eval-when-compile (require 'cl-lib))
      27             : 
      28             : (defvar epg-user-id nil
      29             :   "GnuPG ID of your default identity.")
      30             : 
      31             : (defvar epg-user-id-alist nil
      32             :   "An alist mapping from key ID to user ID.")
      33             : 
      34             : (defvar epg-last-status nil)
      35             : (defvar epg-read-point nil)
      36             : (defvar epg-process-filter-running nil)
      37             : (defvar epg-pending-status-list nil)
      38             : (defvar epg-key-id nil)
      39             : (defvar epg-context nil)
      40             : (defvar epg-debug-buffer nil)
      41             : (defvar epg-agent-file nil)
      42             : (defvar epg-agent-mtime nil)
      43             : 
      44             : ;; from gnupg/include/cipher.h
      45             : (defconst epg-cipher-algorithm-alist
      46             :   '((0 . "NONE")
      47             :     (1 . "IDEA")
      48             :     (2 . "3DES")
      49             :     (3 . "CAST5")
      50             :     (4 . "BLOWFISH")
      51             :     (7 . "AES")
      52             :     (8 . "AES192")
      53             :     (9 . "AES256")
      54             :     (10 . "TWOFISH")
      55             :     (11 . "CAMELLIA128")
      56             :     (12 . "CAMELLIA256")
      57             :     (110 . "DUMMY")))
      58             : 
      59             : ;; from gnupg/include/cipher.h
      60             : (defconst epg-pubkey-algorithm-alist
      61             :   '((1 . "RSA")
      62             :     (2 . "RSA_E")
      63             :     (3 . "RSA_S")
      64             :     (16 . "ELGAMAL_E")
      65             :     (17 . "DSA")
      66             :     (20 . "ELGAMAL")))
      67             : 
      68             : ;; from gnupg/include/cipher.h
      69             : (defconst epg-digest-algorithm-alist
      70             :   '((1 . "MD5")
      71             :     (2 . "SHA1")
      72             :     (3 . "RIPEMD160")
      73             :     (8 . "SHA256")
      74             :     (9 . "SHA384")
      75             :     (10 . "SHA512")
      76             :     (11 . "SHA224")))
      77             : 
      78             : ;; from gnupg/include/cipher.h
      79             : (defconst epg-compress-algorithm-alist
      80             :   '((0 . "NONE")
      81             :     (1 . "ZIP")
      82             :     (2 . "ZLIB")
      83             :     (3 . "BZIP2")))
      84             : 
      85             : (defconst epg-invalid-recipients-reason-alist
      86             :   '((0 . "No specific reason given")
      87             :     (1 . "Not Found")
      88             :     (2 . "Ambiguous specification")
      89             :     (3 . "Wrong key usage")
      90             :     (4 . "Key revoked")
      91             :     (5 . "Key expired")
      92             :     (6 . "No CRL known")
      93             :     (7 . "CRL too old")
      94             :     (8 . "Policy mismatch")
      95             :     (9 . "Not a secret key")
      96             :     (10 . "Key not trusted")))
      97             : 
      98             : (defconst epg-delete-problem-reason-alist
      99             :   '((1 . "No such key")
     100             :     (2 . "Must delete secret key first")
     101             :     (3 . "Ambiguous specification")))
     102             : 
     103             : (defconst epg-import-ok-reason-alist
     104             :   '((0 . "Not actually changed")
     105             :     (1 . "Entirely new key")
     106             :     (2 . "New user IDs")
     107             :     (4 . "New signatures")
     108             :     (8 . "New subkeys")
     109             :     (16 . "Contains private key")))
     110             : 
     111             : (defconst epg-import-problem-reason-alist
     112             :   '((0 . "No specific reason given")
     113             :     (1 . "Invalid Certificate")
     114             :     (2 . "Issuer Certificate missing")
     115             :     (3 . "Certificate Chain too long")
     116             :     (4 . "Error storing certificate")))
     117             : 
     118             : (defconst epg-no-data-reason-alist
     119             :   '((1 . "No armored data")
     120             :     (2 . "Expected a packet but did not found one")
     121             :     (3 . "Invalid packet found, this may indicate a non OpenPGP message")
     122             :     (4 . "Signature expected but not found")))
     123             : 
     124             : (defconst epg-unexpected-reason-alist nil)
     125             : 
     126             : (defvar epg-key-validity-alist
     127             :   '((?o . unknown)
     128             :     (?i . invalid)
     129             :     (?d . disabled)
     130             :     (?r . revoked)
     131             :     (?e . expired)
     132             :     (?- . none)
     133             :     (?q . undefined)
     134             :     (?n . never)
     135             :     (?m . marginal)
     136             :     (?f . full)
     137             :     (?u . ultimate)))
     138             : 
     139             : (defvar epg-key-capability-alist
     140             :   '((?e . encrypt)
     141             :     (?s . sign)
     142             :     (?c . certify)
     143             :     (?a . authentication)
     144             :     (?D . disabled)))
     145             : 
     146             : (defvar epg-new-signature-type-alist
     147             :   '((?D . detached)
     148             :     (?C . clear)
     149             :     (?S . normal)))
     150             : 
     151             : (defvar epg-dn-type-alist
     152             :   '(("1.2.840.113549.1.9.1" . "EMail")
     153             :     ("2.5.4.12" . "T")
     154             :     ("2.5.4.42" . "GN")
     155             :     ("2.5.4.4" . "SN")
     156             :     ("0.2.262.1.10.7.20" . "NameDistinguisher")
     157             :     ("2.5.4.16" . "ADDR")
     158             :     ("2.5.4.15" . "BC")
     159             :     ("2.5.4.13" . "D")
     160             :     ("2.5.4.17" . "PostalCode")
     161             :     ("2.5.4.65" . "Pseudo")
     162             :     ("2.5.4.5" . "SerialNumber")))
     163             : 
     164             : (defvar epg-prompt-alist nil)
     165             : 
     166             : (define-error 'epg-error "GPG error")
     167             : 
     168             : (cl-defstruct (epg-data
     169             :                (:constructor nil)
     170             :                (:constructor epg-make-data-from-file (file))
     171             :                (:constructor epg-make-data-from-string (string))
     172             :                (:copier nil)
     173             :                (:predicate nil))
     174             :   (file nil :read-only t)
     175             :   (string nil :read-only t))
     176             : 
     177             : (defmacro epg--gv-nreverse (place)
     178           3 :   (gv-letplace (getter setter) place
     179           3 :     (funcall setter `(nreverse ,getter))))
     180             : 
     181             : (cl-defstruct (epg-context
     182             :                (:constructor nil)
     183             :                (:constructor epg-context--make
     184             :                 (protocol &optional armor textmode include-certs
     185             :                           cipher-algorithm digest-algorithm
     186             :                           compress-algorithm
     187             :                  &aux
     188             :                  (program
     189           0 :                   (let ((configuration (epg-find-configuration protocol)))
     190           0 :                     (unless configuration
     191           0 :                       (signal 'epg-error
     192           0 :                               (list "no usable configuration" protocol)))
     193           0 :                     (alist-get 'program configuration)))))
     194             :                (:copier nil)
     195             :                (:predicate nil))
     196             :   protocol
     197             :   program
     198           0 :   (home-directory epg-gpg-home-directory)
     199             :   armor
     200             :   textmode
     201             :   include-certs
     202             :   cipher-algorithm
     203             :   digest-algorithm
     204             :   compress-algorithm
     205           0 :   (passphrase-callback (list #'epg-passphrase-callback-function))
     206             :   progress-callback
     207             :   edit-callback
     208             :   signers
     209             :   sig-notations
     210             :   process
     211             :   output-file
     212             :   result
     213             :   operation
     214             :   pinentry-mode
     215             :   (error-output "")
     216             :   error-buffer)
     217             : 
     218             : ;; This is not an alias, just so we can mark it as autoloaded.
     219             : ;;;###autoload
     220             : (defun epg-make-context (&optional protocol armor textmode include-certs
     221             :                                    cipher-algorithm digest-algorithm
     222             :                                    compress-algorithm)
     223             :   "Return a context object."
     224           0 :   (epg-context--make (or protocol 'OpenPGP)
     225           0 :                      armor textmode include-certs
     226           0 :                      cipher-algorithm digest-algorithm
     227           0 :                      compress-algorithm))
     228             : 
     229             : (defun epg-context-set-armor (context armor)
     230             :   "Specify if the output should be ASCII armored in CONTEXT."
     231             :   (declare (obsolete setf "25.1"))
     232           0 :   (setf (epg-context-armor context) armor))
     233             : 
     234             : (defun epg-context-set-textmode (context textmode)
     235             :   "Specify if canonical text mode should be used in CONTEXT."
     236             :   (declare (obsolete setf "25.1"))
     237           0 :   (setf (epg-context-textmode context) textmode))
     238             : 
     239             : (defun epg-context-set-passphrase-callback (context
     240             :                                             passphrase-callback)
     241             :   "Set the function used to query passphrase.
     242             : 
     243             : PASSPHRASE-CALLBACK is either a function, or a cons-cell whose
     244             : car is a function and cdr is a callback data.
     245             : 
     246             : The function gets three arguments: the context, the key-id in
     247             : question, and the callback data (if any).
     248             : 
     249             : The callback may not be called if you use GnuPG 2.x, which relies
     250             : on the external program called `gpg-agent' for passphrase query.
     251             : If you really want to intercept passphrase query, consider
     252             : installing GnuPG 1.x _along with_ GnuPG 2.x, which does passphrase
     253             : query by itself and Emacs can intercept them."
     254             :   ;; (declare (obsolete setf "25.1"))
     255           0 :   (setf (epg-context-passphrase-callback context)
     256           0 :         (if (functionp passphrase-callback)
     257           0 :             (list passphrase-callback)
     258           0 :           passphrase-callback)))
     259             : 
     260             : (defun epg-context-set-progress-callback (context
     261             :                                           progress-callback)
     262             :   "Set the function which handles progress update.
     263             : 
     264             : PROGRESS-CALLBACK is either a function, or a cons-cell whose
     265             : car is a function and cdr is a callback data.
     266             : 
     267             : The function gets six arguments: the context, the operation
     268             : description, the character to display a progress unit, the
     269             : current amount done, the total amount to be done, and the
     270             : callback data (if any)."
     271           0 :   (setf (epg-context-progress-callback context)
     272           0 :         (if (functionp progress-callback)
     273           0 :             (list progress-callback)
     274           0 :           progress-callback)))
     275             : 
     276             : (defun epg-context-set-signers (context signers)
     277             :   "Set the list of key-id for signing."
     278             :   (declare (obsolete setf "25.1"))
     279           0 :   (setf (epg-context-signers context) signers))
     280             : 
     281             : (cl-defstruct (epg-signature
     282             :                (:constructor nil)
     283             :                (:constructor epg-make-signature
     284             :                 (status &optional key-id))
     285             :                (:copier nil)
     286             :                (:predicate nil))
     287             :   status
     288             :   key-id
     289             :   validity
     290             :   fingerprint
     291             :   creation-time
     292             :   expiration-time
     293             :   pubkey-algorithm
     294             :   digest-algorithm
     295             :   class
     296             :   version
     297             :   notations)
     298             : 
     299             : (cl-defstruct (epg-new-signature
     300             :                (:constructor nil)
     301             :                (:constructor epg-make-new-signature
     302             :                 (type pubkey-algorithm digest-algorithm
     303             :                       class creation-time fingerprint))
     304             :                (:copier nil)
     305             :                (:predicate nil))
     306             :   (type nil :read-only t)
     307             :   (pubkey-algorithm nil :read-only t)
     308             :   (digest-algorithm nil :read-only t)
     309             :   (class nil :read-only t)
     310             :   (creation-time nil :read-only t)
     311             :   (fingerprint nil :read-only t))
     312             : 
     313             : (cl-defstruct (epg-key
     314             :                (:constructor nil)
     315             :                (:constructor epg-make-key (owner-trust))
     316             :                (:copier nil)
     317             :                (:predicate nil))
     318             :   (owner-trust nil :read-only t)
     319             :   sub-key-list user-id-list)
     320             : 
     321             : (cl-defstruct (epg-sub-key
     322             :                (:constructor nil)
     323             :                (:constructor epg-make-sub-key
     324             :                 (validity capability secret-p algorithm length id
     325             :                           creation-time expiration-time))
     326             :                (:copier nil)
     327             :                (:predicate nil))
     328             :   validity capability secret-p algorithm length id
     329             :   creation-time expiration-time fingerprint)
     330             : 
     331             : (cl-defstruct (epg-user-id
     332             :                (:constructor nil)
     333             :                (:constructor epg-make-user-id (validity string))
     334             :                (:copier nil)
     335             :                (:predicate nil))
     336             :   validity string signature-list)
     337             : 
     338             : (cl-defstruct (epg-key-signature
     339             :                (:constructor nil)
     340             :                (:constructor epg-make-key-signature
     341             :                 (validity pubkey-algorithm key-id creation-time
     342             :                           expiration-time user-id class
     343             :                           exportable-p))
     344             :                (:copier nil)
     345             :                (:predicate nil))
     346             :   validity pubkey-algorithm key-id creation-time
     347             :   expiration-time user-id class
     348             :   exportable-p)
     349             : 
     350             : (cl-defstruct (epg-sig-notation
     351             :                (:constructor nil)
     352             :                (:constructor epg-make-sig-notation
     353             :                 (name value &optional human-readable critical))
     354             :                (:copier nil)
     355             :                (:predicate nil))
     356             :   name value human-readable critical)
     357             : 
     358             : (cl-defstruct (epg-import-status
     359             :                (:constructor nil)
     360             :                (:constructor epg-make-import-status
     361             :                 (fingerprint
     362             :                  &optional reason new user-id signature sub-key secret))
     363             :                (:copier nil)
     364             :                (:predicate nil))
     365             :   fingerprint reason new user-id signature sub-key secret)
     366             : 
     367             : (cl-defstruct (epg-import-result
     368             :                (:constructor nil)
     369             :                (:constructor epg-make-import-result
     370             :                 (considered no-user-id imported imported-rsa
     371             :                             unchanged new-user-ids new-sub-keys
     372             :                             new-signatures new-revocations
     373             :                             secret-read secret-imported
     374             :                             secret-unchanged not-imported
     375             :                             imports))
     376             :                (:copier nil)
     377             :                (:predicate nil))
     378             :   considered no-user-id imported imported-rsa
     379             :   unchanged new-user-ids new-sub-keys
     380             :   new-signatures new-revocations
     381             :   secret-read secret-imported
     382             :   secret-unchanged not-imported
     383             :   imports)
     384             : 
     385             : (defun epg-context-result-for (context name)
     386             :   "Return the result of CONTEXT associated with NAME."
     387           0 :   (cdr (assq name (epg-context-result context))))
     388             : 
     389             : (defun epg-context-set-result-for (context name value)
     390             :   "Set the result of CONTEXT associated with NAME to VALUE."
     391           0 :   (let* ((result (epg-context-result context))
     392           0 :          (entry (assq name result)))
     393           0 :     (if entry
     394           0 :         (setcdr entry value)
     395           0 :       (setf (epg-context-result context) (cons (cons name value) result)))))
     396             : 
     397             : (defun epg-signature-to-string (signature)
     398             :   "Convert SIGNATURE to a human readable string."
     399           0 :   (let* ((user-id (cdr (assoc (epg-signature-key-id signature)
     400           0 :                               epg-user-id-alist)))
     401           0 :          (pubkey-algorithm (epg-signature-pubkey-algorithm signature))
     402           0 :          (key-id (epg-signature-key-id signature)))
     403           0 :     (concat
     404           0 :      (cond ((eq (epg-signature-status signature) 'good)
     405             :             "Good signature from ")
     406           0 :            ((eq (epg-signature-status signature) 'bad)
     407             :             "Bad signature from ")
     408           0 :            ((eq (epg-signature-status signature) 'expired)
     409             :             "Expired signature from ")
     410           0 :            ((eq (epg-signature-status signature) 'expired-key)
     411             :             "Signature made by expired key ")
     412           0 :            ((eq (epg-signature-status signature) 'revoked-key)
     413             :             "Signature made by revoked key ")
     414           0 :            ((eq (epg-signature-status signature) 'no-pubkey)
     415           0 :             "No public key for "))
     416           0 :      key-id
     417           0 :      (if user-id
     418           0 :          (concat " "
     419           0 :                  (if (stringp user-id)
     420           0 :                      user-id
     421           0 :                    (epg-decode-dn user-id)))
     422           0 :        "")
     423           0 :      (if (epg-signature-validity signature)
     424           0 :          (format " (trust %s)"  (epg-signature-validity signature))
     425           0 :        "")
     426           0 :      (if (epg-signature-creation-time signature)
     427           0 :          (format-time-string " created at %Y-%m-%dT%T%z"
     428           0 :                              (epg-signature-creation-time signature))
     429           0 :        "")
     430           0 :      (if pubkey-algorithm
     431           0 :          (concat " using "
     432           0 :                  (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
     433           0 :                      (format "(unknown algorithm %d)" pubkey-algorithm)))
     434           0 :        ""))))
     435             : 
     436             : (defun epg-verify-result-to-string (verify-result)
     437             :   "Convert VERIFY-RESULT to a human readable string."
     438           0 :   (mapconcat #'epg-signature-to-string verify-result "\n"))
     439             : 
     440             : (defun epg-new-signature-to-string (new-signature)
     441             :   "Convert NEW-SIGNATURE to a human readable string."
     442           0 :   (concat
     443           0 :    (cond ((eq (epg-new-signature-type new-signature) 'detached)
     444             :           "Detached signature ")
     445           0 :          ((eq (epg-new-signature-type new-signature) 'clear)
     446             :           "Cleartext signature ")
     447             :          (t
     448           0 :           "Signature "))
     449           0 :    (cdr (assq (epg-new-signature-pubkey-algorithm new-signature)
     450           0 :               epg-pubkey-algorithm-alist))
     451             :    "/"
     452           0 :    (cdr (assq (epg-new-signature-digest-algorithm new-signature)
     453           0 :               epg-digest-algorithm-alist))
     454             :    " "
     455           0 :    (format "%02X " (epg-new-signature-class new-signature))
     456           0 :    (epg-new-signature-fingerprint new-signature)))
     457             : 
     458             : (defun epg-import-result-to-string (import-result)
     459             :   "Convert IMPORT-RESULT to a human readable string."
     460           0 :   (concat (format "Total number processed: %d\n"
     461           0 :                   (epg-import-result-considered import-result))
     462           0 :           (if (> (epg-import-result-not-imported import-result) 0)
     463           0 :               (format "      skipped new keys: %d\n"
     464           0 :                       (epg-import-result-not-imported import-result)))
     465           0 :           (if (> (epg-import-result-no-user-id import-result) 0)
     466           0 :               (format "          w/o user IDs: %d\n"
     467           0 :                       (epg-import-result-no-user-id import-result)))
     468           0 :           (if (> (epg-import-result-imported import-result) 0)
     469           0 :               (concat (format "              imported: %d"
     470           0 :                               (epg-import-result-imported import-result))
     471           0 :                       (if (> (epg-import-result-imported-rsa import-result) 0)
     472           0 :                           (format "  (RSA: %d)"
     473           0 :                                   (epg-import-result-imported-rsa
     474           0 :                                    import-result)))
     475           0 :                       "\n"))
     476           0 :           (if (> (epg-import-result-unchanged import-result) 0)
     477           0 :               (format "             unchanged: %d\n"
     478           0 :                       (epg-import-result-unchanged import-result)))
     479           0 :           (if (> (epg-import-result-new-user-ids import-result) 0)
     480           0 :               (format "          new user IDs: %d\n"
     481           0 :                       (epg-import-result-new-user-ids import-result)))
     482           0 :           (if (> (epg-import-result-new-sub-keys import-result) 0)
     483           0 :               (format "           new subkeys: %d\n"
     484           0 :                       (epg-import-result-new-sub-keys import-result)))
     485           0 :           (if (> (epg-import-result-new-signatures import-result) 0)
     486           0 :               (format "        new signatures: %d\n"
     487           0 :                       (epg-import-result-new-signatures import-result)))
     488           0 :           (if (> (epg-import-result-new-revocations import-result) 0)
     489           0 :               (format "   new key revocations: %d\n"
     490           0 :                       (epg-import-result-new-revocations import-result)))
     491           0 :           (if (> (epg-import-result-secret-read import-result) 0)
     492           0 :               (format "      secret keys read: %d\n"
     493           0 :                       (epg-import-result-secret-read import-result)))
     494           0 :           (if (> (epg-import-result-secret-imported import-result) 0)
     495           0 :               (format "  secret keys imported: %d\n"
     496           0 :                       (epg-import-result-secret-imported import-result)))
     497           0 :           (if (> (epg-import-result-secret-unchanged import-result) 0)
     498           0 :               (format " secret keys unchanged: %d\n"
     499           0 :                       (epg-import-result-secret-unchanged import-result)))))
     500             : 
     501             : (defun epg-error-to-string (error)
     502           0 :   (cond
     503           0 :    ((eq (car error) 'exit)
     504             :     "Exit")
     505           0 :    ((eq (car error) 'quit)
     506             :     "Canceled")
     507           0 :    ((eq (car error) 'no-data)
     508           0 :     (let ((entry (assq (cdr error) epg-no-data-reason-alist)))
     509           0 :       (if entry
     510           0 :           (format "No data (%s)" (downcase (cdr entry)))
     511           0 :         "No data")))
     512           0 :    ((eq (car error) 'unexpected)
     513           0 :     (let ((entry (assq (cdr error) epg-unexpected-reason-alist)))
     514           0 :       (if entry
     515           0 :           (format "Unexpected (%s)" (downcase (cdr entry)))
     516           0 :         "Unexpected")))
     517           0 :    ((eq (car error) 'bad-armor)
     518             :     "Bad armor")
     519           0 :    ((memq (car error) '(invalid-recipient invalid-signer))
     520           0 :     (concat
     521           0 :      (if (eq (car error) 'invalid-recipient)
     522             :          "Unusable public key"
     523           0 :        "Unusable secret key")
     524           0 :      (let ((entry (assq 'requested (cdr error))))
     525           0 :        (if entry
     526           0 :            (format ": %s" (cdr entry))
     527           0 :          ": <unknown>"))
     528           0 :      (let ((entry (assq 'reason (cdr error))))
     529           0 :        (if (and entry
     530           0 :                 (> (cdr entry) 0)    ;no specific reason given
     531           0 :                 (setq entry (assq (cdr entry)
     532           0 :                                   epg-invalid-recipients-reason-alist)))
     533           0 :            (format " (%s)" (downcase (cdr entry)))
     534           0 :          ""))))
     535           0 :    ((eq (car error) 'no-pubkey)
     536           0 :     (format "No public key: %s" (cdr error)))
     537           0 :    ((eq (car error) 'no-seckey)
     538           0 :     (format "No secret key: %s" (cdr error)))
     539           0 :    ((eq (car error) 'no-recipients)
     540             :     "No recipients")
     541           0 :    ((eq (car error) 'no-signers)
     542             :     "No signers")
     543           0 :    ((eq (car error) 'delete-problem)
     544           0 :     (let ((entry (assq (cdr error) epg-delete-problem-reason-alist)))
     545           0 :       (if entry
     546           0 :           (format "Delete problem (%s)" (downcase (cdr entry)))
     547           0 :         "Delete problem")))
     548           0 :    ((eq (car error) 'key-not-created)
     549           0 :     "Key not created")))
     550             : 
     551             : (defun epg-errors-to-string (errors)
     552           0 :   (mapconcat #'epg-error-to-string errors "; "))
     553             : 
     554             : (declare-function pinentry-start "pinentry" (&optional quiet))
     555             : 
     556             : (defun epg--start (context args)
     557             :   "Start `epg-gpg-program' in a subprocess with given ARGS."
     558           0 :   (if (and (epg-context-process context)
     559           0 :            (eq (process-status (epg-context-process context)) 'run))
     560           0 :       (error "%s is already running in this context"
     561           0 :              (epg-context-program context)))
     562           0 :   (let* ((agent-info (getenv "GPG_AGENT_INFO"))
     563           0 :          (args (append (list "--no-tty"
     564             :                              "--status-fd" "1"
     565           0 :                              "--yes")
     566           0 :                        (if (and (not (eq (epg-context-protocol context) 'CMS))
     567           0 :                                 (string-match ":" (or agent-info "")))
     568           0 :                            '("--use-agent"))
     569           0 :                        (if (and (not (eq (epg-context-protocol context) 'CMS))
     570           0 :                                 (epg-context-progress-callback context))
     571           0 :                            '("--enable-progress-filter"))
     572           0 :                        (if (epg-context-home-directory context)
     573           0 :                            (list "--homedir"
     574           0 :                                  (epg-context-home-directory context)))
     575           0 :                        (unless (eq (epg-context-protocol context) 'CMS)
     576           0 :                          '("--command-fd" "0"))
     577           0 :                        (if (epg-context-armor context) '("--armor"))
     578           0 :                        (if (epg-context-textmode context) '("--textmode"))
     579           0 :                        (if (epg-context-output-file context)
     580           0 :                            (list "--output" (epg-context-output-file context)))
     581           0 :                        (if (epg-context-pinentry-mode context)
     582           0 :                            (list "--pinentry-mode"
     583           0 :                                  (symbol-name (epg-context-pinentry-mode
     584           0 :                                                context))))
     585           0 :                        args))
     586           0 :          (process-environment process-environment)
     587           0 :          (buffer (generate-new-buffer " *epg*"))
     588             :          error-process
     589             :          process
     590             :          terminal-name
     591             :          agent-file
     592             :          (agent-mtime '(0 0 0 0)))
     593             :     ;; Set GPG_TTY and TERM for pinentry-curses.  Note that we can't
     594             :     ;; use `terminal-name' here to get the real pty name for the child
     595             :     ;; process, though /dev/fd/0" is not portable.
     596           0 :     (unless (memq system-type '(ms-dos windows-nt))
     597           0 :       (with-temp-buffer
     598           0 :         (condition-case nil
     599           0 :             (when (= (call-process "tty" "/dev/fd/0" t) 0)
     600           0 :               (delete-char -1)
     601           0 :               (setq terminal-name (buffer-string)))
     602           0 :           (file-error))))
     603           0 :     (when terminal-name
     604           0 :       (setq process-environment
     605           0 :             (cons (concat "GPG_TTY=" terminal-name)
     606           0 :                   (cons "TERM=xterm" process-environment))))
     607             :     ;; Automatically start the Emacs Pinentry server if appropriate.
     608           0 :     (when (and (fboundp 'pinentry-start)
     609             :                ;; Emacs Pinentry is useless if Emacs has no interactive session.
     610           0 :                (not noninteractive)
     611             :                ;; Prefer pinentry-mode over Emacs Pinentry.
     612           0 :                (null (epg-context-pinentry-mode context))
     613             :                ;; Check if the allow-emacs-pinentry option is set.
     614           0 :                (executable-find epg-gpgconf-program)
     615           0 :                (with-temp-buffer
     616           0 :                  (when (= (call-process epg-gpgconf-program nil t nil
     617           0 :                                         "--list-options" "gpg-agent")
     618           0 :                           0)
     619           0 :                    (goto-char (point-min))
     620           0 :                    (re-search-forward
     621             :                     "^allow-emacs-pinentry:\\(?:.*:\\)\\{8\\}1"
     622           0 :                     nil t))))
     623           0 :       (pinentry-start 'quiet))
     624           0 :     (setq process-environment
     625           0 :           (cons (format "INSIDE_EMACS=%s,epg" emacs-version)
     626           0 :                 process-environment))
     627             :     ;; Record modified time of gpg-agent socket to restore the Emacs
     628             :     ;; frame on text terminal in `epg-wait-for-completion'.
     629             :     ;; See
     630             :     ;; <http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00755.html>
     631             :     ;; for more details.
     632           0 :     (when (and agent-info (string-match "\\(.*\\):[0-9]+:[0-9]+" agent-info))
     633           0 :       (setq agent-file (match-string 1 agent-info)
     634           0 :             agent-mtime (or (nth 5 (file-attributes agent-file)) '(0 0 0 0))))
     635           0 :     (if epg-debug
     636           0 :         (save-excursion
     637           0 :           (unless epg-debug-buffer
     638           0 :             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
     639           0 :           (set-buffer epg-debug-buffer)
     640           0 :           (goto-char (point-max))
     641           0 :           (insert (if agent-info
     642           0 :                       (format "GPG_AGENT_INFO=%s\n" agent-info)
     643           0 :                     "GPG_AGENT_INFO is not set\n")
     644           0 :                   (format "%s %s\n"
     645           0 :                           (epg-context-program context)
     646           0 :                           (mapconcat #'identity args " ")))))
     647           0 :     (with-current-buffer buffer
     648           0 :       (if (fboundp 'set-buffer-multibyte)
     649           0 :           (set-buffer-multibyte nil))
     650           0 :       (make-local-variable 'epg-last-status)
     651           0 :       (setq epg-last-status nil)
     652           0 :       (make-local-variable 'epg-read-point)
     653           0 :       (setq epg-read-point (point-min))
     654           0 :       (make-local-variable 'epg-process-filter-running)
     655           0 :       (setq epg-process-filter-running nil)
     656           0 :       (make-local-variable 'epg-pending-status-list)
     657           0 :       (setq epg-pending-status-list nil)
     658           0 :       (make-local-variable 'epg-key-id)
     659           0 :       (setq epg-key-id nil)
     660           0 :       (make-local-variable 'epg-context)
     661           0 :       (setq epg-context context)
     662           0 :       (make-local-variable 'epg-agent-file)
     663           0 :       (setq epg-agent-file agent-file)
     664           0 :       (make-local-variable 'epg-agent-mtime)
     665           0 :       (setq epg-agent-mtime agent-mtime))
     666           0 :     (setq error-process
     667           0 :           (make-pipe-process :name "epg-error"
     668           0 :                              :buffer (generate-new-buffer " *epg-error*")
     669             :                              ;; Suppress "XXX finished" line.
     670           0 :                              :sentinel #'ignore
     671           0 :                              :noquery t))
     672           0 :     (setf (epg-context-error-buffer context) (process-buffer error-process))
     673           0 :     (with-file-modes 448
     674           0 :       (setq process (make-process :name "epg"
     675           0 :                                   :buffer buffer
     676           0 :                                   :command (cons (epg-context-program context)
     677           0 :                                                  args)
     678             :                                   :connection-type 'pipe
     679             :                                   :coding '(binary . binary)
     680           0 :                                   :filter #'epg--process-filter
     681           0 :                                   :stderr error-process
     682           0 :                                   :noquery t)))
     683           0 :     (setf (epg-context-process context) process)))
     684             : 
     685             : (defun epg--process-filter (process input)
     686           0 :   (if epg-debug
     687           0 :       (with-current-buffer
     688           0 :           (or epg-debug-buffer
     689           0 :               (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
     690           0 :         (goto-char (point-max))
     691           0 :         (insert input)))
     692           0 :   (if (buffer-live-p (process-buffer process))
     693           0 :       (with-current-buffer (process-buffer process)
     694           0 :         (save-excursion
     695           0 :           (goto-char (point-max))
     696           0 :           (insert input)
     697           0 :           (unless epg-process-filter-running
     698           0 :             (let ((epg-process-filter-running t))
     699           0 :               (goto-char epg-read-point)
     700           0 :               (beginning-of-line)
     701           0 :               (while (looking-at ".*\n") ;the input line finished
     702           0 :                 (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
     703           0 :                     (let ((status (match-string 1))
     704           0 :                           (string (match-string 2))
     705             :                           symbol)
     706           0 :                       (if (member status epg-pending-status-list)
     707           0 :                           (setq epg-pending-status-list nil))
     708             :                       ;; When editing a key, delegate all interaction
     709             :                       ;; to edit-callback.
     710           0 :                       (if (eq (epg-context-operation epg-context) 'edit-key)
     711           0 :                           (funcall (car (epg-context-edit-callback
     712           0 :                                          epg-context))
     713           0 :                                    epg-context
     714           0 :                                    status
     715           0 :                                    string
     716           0 :                                    (cdr (epg-context-edit-callback
     717           0 :                                          epg-context)))
     718             :                         ;; Otherwise call epg--status-STATUS function.
     719           0 :                         (setq symbol (intern-soft (concat "epg--status-"
     720           0 :                                                           status)))
     721           0 :                         (if (and symbol
     722           0 :                                  (fboundp symbol))
     723           0 :                             (funcall symbol epg-context string)))
     724           0 :                       (setq epg-last-status (cons status string))))
     725           0 :                 (forward-line)
     726           0 :                 (setq epg-read-point (point)))))))))
     727             : 
     728             : (defun epg-read-output (context)
     729             :   "Read the output file CONTEXT and return the content as a string."
     730           0 :   (with-temp-buffer
     731           0 :     (if (fboundp 'set-buffer-multibyte)
     732           0 :         (set-buffer-multibyte nil))
     733           0 :     (if (file-exists-p (epg-context-output-file context))
     734           0 :         (let ((coding-system-for-read 'binary))
     735           0 :           (insert-file-contents (epg-context-output-file context))
     736           0 :           (buffer-string)))))
     737             : 
     738             : (defun epg-wait-for-status (context status-list)
     739             :   "Wait until one of elements in STATUS-LIST arrives."
     740           0 :   (with-current-buffer (process-buffer (epg-context-process context))
     741           0 :     (setq epg-pending-status-list status-list)
     742           0 :     (while (and (eq (process-status (epg-context-process context)) 'run)
     743           0 :                 epg-pending-status-list)
     744           0 :       (accept-process-output (epg-context-process context) 1))
     745           0 :     (if epg-pending-status-list
     746           0 :         (epg-context-set-result-for
     747           0 :          context 'error
     748           0 :          (cons '(exit)
     749           0 :                (epg-context-result-for context 'error))))))
     750             : 
     751             : (defun epg-wait-for-completion (context)
     752             :   "Wait until the `epg-gpg-program' process completes."
     753           0 :   (while (eq (process-status (epg-context-process context)) 'run)
     754           0 :     (accept-process-output (epg-context-process context) 1))
     755             :   ;; This line is needed to run the process-filter right now.
     756           0 :   (sleep-for 0.1)
     757             :   ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated.
     758           0 :   (if (with-current-buffer (process-buffer (epg-context-process context))
     759           0 :         (and epg-agent-file
     760           0 :              (> (float-time (or (nth 5 (file-attributes epg-agent-file))
     761           0 :                                 '(0 0 0 0)))
     762           0 :                 (float-time epg-agent-mtime))))
     763           0 :       (redraw-frame))
     764           0 :   (epg-context-set-result-for
     765           0 :    context 'error
     766           0 :    (nreverse (epg-context-result-for context 'error)))
     767           0 :   (setf (epg-context-error-output context)
     768           0 :         (with-current-buffer (epg-context-error-buffer context)
     769           0 :           (buffer-string))))
     770             : 
     771             : (defun epg-reset (context)
     772             :   "Reset the CONTEXT."
     773           0 :   (if (and (epg-context-process context)
     774           0 :            (buffer-live-p (process-buffer (epg-context-process context))))
     775           0 :       (kill-buffer (process-buffer (epg-context-process context))))
     776           0 :   (if (buffer-live-p (epg-context-error-buffer context))
     777           0 :       (kill-buffer (epg-context-error-buffer context)))
     778           0 :   (setf (epg-context-process context) nil)
     779           0 :   (setf (epg-context-edit-callback context) nil))
     780             : 
     781             : (defun epg-delete-output-file (context)
     782             :   "Delete the output file of CONTEXT."
     783           0 :   (if (and (epg-context-output-file context)
     784           0 :            (file-exists-p (epg-context-output-file context)))
     785           0 :       (delete-file (epg-context-output-file context))))
     786             : 
     787             : (eval-and-compile
     788             :   (if (fboundp 'decode-coding-string)
     789             :       (defalias 'epg--decode-coding-string 'decode-coding-string)
     790             :     (defalias 'epg--decode-coding-string 'identity)))
     791             : 
     792             : (defun epg--status-USERID_HINT (_context string)
     793           0 :   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
     794           0 :       (let* ((key-id (match-string 1 string))
     795           0 :              (user-id (match-string 2 string))
     796           0 :              (entry (assoc key-id epg-user-id-alist)))
     797           0 :         (condition-case nil
     798           0 :             (setq user-id (epg--decode-coding-string
     799           0 :                            (epg--decode-percent-escape user-id)
     800           0 :                            'utf-8))
     801           0 :           (error))
     802           0 :         (if entry
     803           0 :             (setcdr entry user-id)
     804           0 :           (setq epg-user-id-alist (cons (cons key-id user-id)
     805           0 :                                         epg-user-id-alist))))))
     806             : 
     807             : (defun epg--status-NEED_PASSPHRASE (_context string)
     808           0 :   (if (string-match "\\`\\([^ ]+\\)" string)
     809           0 :       (setq epg-key-id (match-string 1 string))))
     810             : 
     811             : (defun epg--status-NEED_PASSPHRASE_SYM (_context _string)
     812           0 :   (setq epg-key-id 'SYM))
     813             : 
     814             : (defun epg--status-NEED_PASSPHRASE_PIN (_context _string)
     815           0 :   (setq epg-key-id 'PIN))
     816             : 
     817             : (eval-and-compile
     818             :   (if (fboundp 'clear-string)
     819             :       (defalias 'epg--clear-string 'clear-string)
     820             :     (defun epg--clear-string (string)
     821             :       (fillarray string 0))))
     822             : 
     823             : (eval-and-compile
     824             :   (if (fboundp 'encode-coding-string)
     825             :       (defalias 'epg--encode-coding-string 'encode-coding-string)
     826             :     (defalias 'epg--encode-coding-string 'identity)))
     827             : 
     828             : (defun epg--status-GET_HIDDEN (context string)
     829           0 :   (when (and epg-key-id
     830           0 :              (string-match "\\`passphrase\\." string))
     831           0 :     (unless (epg-context-passphrase-callback context)
     832           0 :       (error "passphrase-callback not set"))
     833           0 :     (let (inhibit-quit
     834             :           passphrase
     835             :           passphrase-with-new-line
     836             :           encoded-passphrase-with-new-line)
     837           0 :       (unwind-protect
     838           0 :           (condition-case nil
     839           0 :               (progn
     840           0 :                 (setq passphrase
     841           0 :                       (funcall
     842           0 :                        (car (epg-context-passphrase-callback context))
     843           0 :                        context
     844           0 :                        epg-key-id
     845           0 :                        (cdr (epg-context-passphrase-callback context))))
     846           0 :                 (when passphrase
     847           0 :                   (setq passphrase-with-new-line (concat passphrase "\n"))
     848           0 :                   (epg--clear-string passphrase)
     849           0 :                   (setq passphrase nil)
     850           0 :                   (if epg-passphrase-coding-system
     851           0 :                       (progn
     852           0 :                         (setq encoded-passphrase-with-new-line
     853           0 :                               (epg--encode-coding-string
     854           0 :                                passphrase-with-new-line
     855           0 :                                (coding-system-change-eol-conversion
     856           0 :                                 epg-passphrase-coding-system 'unix)))
     857           0 :                         (epg--clear-string passphrase-with-new-line)
     858           0 :                         (setq passphrase-with-new-line nil))
     859           0 :                     (setq encoded-passphrase-with-new-line
     860           0 :                           passphrase-with-new-line
     861           0 :                           passphrase-with-new-line nil))
     862           0 :                   (process-send-string (epg-context-process context)
     863           0 :                                        encoded-passphrase-with-new-line)))
     864             :             (quit
     865           0 :              (epg-context-set-result-for
     866           0 :               context 'error
     867           0 :               (cons '(quit)
     868           0 :                     (epg-context-result-for context 'error)))
     869           0 :              (delete-process (epg-context-process context))))
     870           0 :         (if passphrase
     871           0 :             (epg--clear-string passphrase))
     872           0 :         (if passphrase-with-new-line
     873           0 :             (epg--clear-string passphrase-with-new-line))
     874           0 :         (if encoded-passphrase-with-new-line
     875           0 :             (epg--clear-string encoded-passphrase-with-new-line))))))
     876             : 
     877             : (defun epg--prompt-GET_BOOL (_context string)
     878           0 :   (let ((entry (assoc string epg-prompt-alist)))
     879           0 :     (y-or-n-p (if entry (cdr entry) (concat string "? ")))))
     880             : 
     881             : (defun epg--prompt-GET_BOOL-untrusted_key.override (_context _string)
     882           0 :   (y-or-n-p (if (and (equal (car epg-last-status) "USERID_HINT")
     883           0 :                      (string-match "\\`\\([^ ]+\\) \\(.*\\)"
     884           0 :                                    (cdr epg-last-status)))
     885           0 :                 (let* ((key-id (match-string 1 (cdr epg-last-status)))
     886           0 :                        (user-id (match-string 2 (cdr epg-last-status)))
     887           0 :                        (entry (assoc key-id epg-user-id-alist)))
     888           0 :                   (if entry
     889           0 :                       (setq user-id (cdr entry)))
     890           0 :                   (format "Untrusted key %s %s.  Use anyway? " key-id user-id))
     891           0 :               "Use untrusted key anyway? ")))
     892             : 
     893             : (defun epg--status-GET_BOOL (context string)
     894           0 :   (let (inhibit-quit)
     895           0 :     (condition-case nil
     896           0 :         (if (funcall (or (intern-soft (concat "epg--prompt-GET_BOOL-" string))
     897           0 :                          #'epg--prompt-GET_BOOL)
     898           0 :                      context string)
     899           0 :             (process-send-string (epg-context-process context) "y\n")
     900           0 :           (process-send-string (epg-context-process context) "n\n"))
     901             :       (quit
     902           0 :        (epg-context-set-result-for
     903           0 :         context 'error
     904           0 :         (cons '(quit)
     905           0 :               (epg-context-result-for context 'error)))
     906           0 :        (delete-process (epg-context-process context))))))
     907             : 
     908             : (defun epg--status-GET_LINE (context string)
     909           0 :   (let ((entry (assoc string epg-prompt-alist))
     910             :         inhibit-quit)
     911           0 :     (condition-case nil
     912           0 :         (process-send-string (epg-context-process context)
     913           0 :                              (concat (read-string
     914           0 :                                       (if entry
     915           0 :                                           (cdr entry)
     916           0 :                                         (concat string ": ")))
     917           0 :                                      "\n"))
     918             :       (quit
     919           0 :        (epg-context-set-result-for
     920           0 :         context 'error
     921           0 :         (cons '(quit)
     922           0 :               (epg-context-result-for context 'error)))
     923           0 :        (delete-process (epg-context-process context))))))
     924             : 
     925             : (defun epg--status-*SIG (context status string)
     926           0 :   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
     927           0 :       (let* ((key-id (match-string 1 string))
     928           0 :              (user-id (match-string 2 string))
     929           0 :              (entry (assoc key-id epg-user-id-alist)))
     930           0 :         (epg-context-set-result-for
     931           0 :          context
     932             :          'verify
     933           0 :          (cons (epg-make-signature status key-id)
     934           0 :                (epg-context-result-for context 'verify)))
     935           0 :         (condition-case nil
     936           0 :             (if (eq (epg-context-protocol context) 'CMS)
     937           0 :                 (setq user-id (epg-dn-from-string user-id))
     938           0 :               (setq user-id (epg--decode-coding-string
     939           0 :                              (epg--decode-percent-escape user-id)
     940           0 :                              'utf-8)))
     941           0 :           (error))
     942           0 :         (if entry
     943           0 :             (setcdr entry user-id)
     944           0 :           (setq epg-user-id-alist
     945           0 :                 (cons (cons key-id user-id) epg-user-id-alist))))
     946           0 :     (epg-context-set-result-for
     947           0 :      context
     948             :      'verify
     949           0 :      (cons (epg-make-signature status)
     950           0 :            (epg-context-result-for context 'verify)))))
     951             : 
     952             : (defun epg--status-GOODSIG (context string)
     953           0 :   (epg--status-*SIG context 'good string))
     954             : 
     955             : (defun epg--status-EXPSIG (context string)
     956           0 :   (epg--status-*SIG context 'expired string))
     957             : 
     958             : (defun epg--status-EXPKEYSIG (context string)
     959           0 :   (epg--status-*SIG context 'expired-key string))
     960             : 
     961             : (defun epg--status-REVKEYSIG (context string)
     962           0 :   (epg--status-*SIG context 'revoked-key string))
     963             : 
     964             : (defun epg--status-BADSIG (context string)
     965           0 :   (epg--status-*SIG context 'bad string))
     966             : 
     967             : (defun epg--status-NO_PUBKEY (context string)
     968           0 :   (if (eq (epg-context-operation context) 'verify)
     969           0 :       (let ((signature (car (epg-context-result-for context 'verify))))
     970           0 :         (if (and signature
     971           0 :                  (eq (epg-signature-status signature) 'error)
     972           0 :                  (equal (epg-signature-key-id signature) string))
     973           0 :             (setf (epg-signature-status signature) 'no-pubkey)))
     974           0 :     (epg-context-set-result-for
     975           0 :      context 'error
     976           0 :      (cons (cons 'no-pubkey string)
     977           0 :            (epg-context-result-for context 'error)))))
     978             : 
     979             : (defun epg--status-NO_SECKEY (context string)
     980           0 :   (epg-context-set-result-for
     981           0 :    context 'error
     982           0 :    (cons (cons 'no-seckey string)
     983           0 :          (epg-context-result-for context 'error))))
     984             : 
     985             : (defun epg--time-from-seconds (seconds)
     986           0 :   (let ((number-seconds (string-to-number (concat seconds ".0"))))
     987           0 :     (cons (floor (/ number-seconds 65536))
     988           0 :           (floor (mod number-seconds 65536)))))
     989             : 
     990             : (defun epg--status-ERRSIG (context string)
     991           0 :   (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \
     992             : \\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)"
     993           0 :                     string)
     994           0 :       (let ((signature (epg-make-signature 'error)))
     995           0 :         (epg-context-set-result-for
     996           0 :          context
     997             :          'verify
     998           0 :          (cons signature
     999           0 :                (epg-context-result-for context 'verify)))
    1000           0 :         (setf (epg-signature-key-id signature)
    1001           0 :               (match-string 1 string))
    1002           0 :         (setf (epg-signature-pubkey-algorithm signature)
    1003           0 :               (string-to-number (match-string 2 string)))
    1004           0 :         (setf (epg-signature-digest-algorithm signature)
    1005           0 :               (string-to-number (match-string 3 string)))
    1006           0 :         (setf (epg-signature-class signature)
    1007           0 :               (string-to-number (match-string 4 string) 16))
    1008           0 :         (setf (epg-signature-creation-time signature)
    1009           0 :               (epg--time-from-seconds (match-string 5 string))))))
    1010             : 
    1011             : (defun epg--status-VALIDSIG (context string)
    1012           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1013           0 :     (when (and signature
    1014           0 :                (eq (epg-signature-status signature) 'good)
    1015           0 :                (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \
    1016             : \\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
    1017             : \\(.*\\)"
    1018           0 :                            string))
    1019           0 :       (setf (epg-signature-fingerprint signature)
    1020           0 :             (match-string 1 string))
    1021           0 :       (setf (epg-signature-creation-time signature)
    1022           0 :             (epg--time-from-seconds (match-string 2 string)))
    1023           0 :       (unless (equal (match-string 3 string) "0")
    1024           0 :         (setf (epg-signature-expiration-time signature)
    1025           0 :               (epg--time-from-seconds (match-string 3 string))))
    1026           0 :       (setf (epg-signature-version signature)
    1027           0 :             (string-to-number (match-string 4 string)))
    1028           0 :       (setf (epg-signature-pubkey-algorithm signature)
    1029           0 :             (string-to-number (match-string 5 string)))
    1030           0 :       (setf (epg-signature-digest-algorithm signature)
    1031           0 :             (string-to-number (match-string 6 string)))
    1032           0 :       (setf (epg-signature-class signature)
    1033           0 :             (string-to-number (match-string 7 string) 16)))))
    1034             : 
    1035             : (defun epg--status-TRUST_UNDEFINED (context _string)
    1036           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1037           0 :     (if (and signature
    1038           0 :              (eq (epg-signature-status signature) 'good))
    1039           0 :         (setf (epg-signature-validity signature) 'undefined))))
    1040             : 
    1041             : (defun epg--status-TRUST_NEVER (context _string)
    1042           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1043           0 :     (if (and signature
    1044           0 :              (eq (epg-signature-status signature) 'good))
    1045           0 :         (setf (epg-signature-validity signature) 'never))))
    1046             : 
    1047             : (defun epg--status-TRUST_MARGINAL (context _string)
    1048           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1049           0 :     (if (and signature
    1050           0 :              (eq (epg-signature-status signature) 'good))
    1051           0 :         (setf (epg-signature-validity signature) 'marginal))))
    1052             : 
    1053             : (defun epg--status-TRUST_FULLY (context _string)
    1054           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1055           0 :     (if (and signature
    1056           0 :              (eq (epg-signature-status signature) 'good))
    1057           0 :         (setf (epg-signature-validity signature) 'full))))
    1058             : 
    1059             : (defun epg--status-TRUST_ULTIMATE (context _string)
    1060           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1061           0 :     (if (and signature
    1062           0 :              (eq (epg-signature-status signature) 'good))
    1063           0 :         (setf (epg-signature-validity signature) 'ultimate))))
    1064             : 
    1065             : (defun epg--status-NOTATION_NAME (context string)
    1066           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1067           0 :     (if signature
    1068           0 :         (push (epg-make-sig-notation string nil t nil)
    1069           0 :               (epg-signature-notations signature)))))
    1070             : 
    1071             : (defun epg--status-NOTATION_DATA (context string)
    1072           0 :   (let ((signature (car (epg-context-result-for context 'verify)))
    1073             :         notation)
    1074           0 :     (if (and signature
    1075           0 :              (setq notation (car (epg-signature-notations signature))))
    1076           0 :         (setf (epg-sig-notation-value notation) string))))
    1077             : 
    1078             : (defun epg--status-POLICY_URL (context string)
    1079           0 :   (let ((signature (car (epg-context-result-for context 'verify))))
    1080           0 :     (if signature
    1081           0 :         (push (epg-make-sig-notation nil string t nil)
    1082           0 :               (epg-signature-notations signature)))))
    1083             : 
    1084             : (defun epg--status-PROGRESS (context string)
    1085           0 :   (if (and (epg-context-progress-callback context)
    1086           0 :            (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
    1087           0 :                          string))
    1088           0 :       (funcall (car (epg-context-progress-callback context))
    1089           0 :                context
    1090           0 :                (match-string 1 string)
    1091           0 :                (match-string 2 string)
    1092           0 :                (string-to-number (match-string 3 string))
    1093           0 :                (string-to-number (match-string 4 string))
    1094           0 :                (cdr (epg-context-progress-callback context)))))
    1095             : 
    1096             : (defun epg--status-ENC_TO (context string)
    1097           0 :   (if (string-match "\\`\\([0-9A-Za-z]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
    1098           0 :       (epg-context-set-result-for
    1099           0 :        context 'encrypted-to
    1100           0 :        (cons (list (match-string 1 string)
    1101           0 :                    (string-to-number (match-string 2 string))
    1102           0 :                    (string-to-number (match-string 3 string)))
    1103           0 :              (epg-context-result-for context 'encrypted-to)))))
    1104             : 
    1105             : (defun epg--status-DECRYPTION_FAILED (context _string)
    1106           0 :   (epg-context-set-result-for context 'decryption-failed t))
    1107             : 
    1108             : (defun epg--status-DECRYPTION_OKAY (context _string)
    1109           0 :   (epg-context-set-result-for context 'decryption-okay t))
    1110             : 
    1111             : (defun epg--status-NODATA (context string)
    1112           0 :   (epg-context-set-result-for
    1113           0 :    context 'error
    1114           0 :    (cons (cons 'no-data (string-to-number string))
    1115           0 :          (epg-context-result-for context 'error))))
    1116             : 
    1117             : (defun epg--status-UNEXPECTED (context string)
    1118           0 :   (epg-context-set-result-for
    1119           0 :    context 'error
    1120           0 :    (cons (cons 'unexpected (string-to-number string))
    1121           0 :          (epg-context-result-for context 'error))))
    1122             : 
    1123             : (defun epg--status-KEYEXPIRED (context string)
    1124           0 :   (epg-context-set-result-for
    1125           0 :    context 'key
    1126           0 :    (cons (list 'key-expired (cons 'expiration-time
    1127           0 :                                   (epg--time-from-seconds string)))
    1128           0 :          (epg-context-result-for context 'key))))
    1129             : 
    1130             : (defun epg--status-KEYREVOKED (context _string)
    1131           0 :   (epg-context-set-result-for
    1132           0 :    context 'key
    1133           0 :    (cons '(key-revoked)
    1134           0 :          (epg-context-result-for context 'key))))
    1135             : 
    1136             : (defun epg--status-BADARMOR (context _string)
    1137           0 :   (epg-context-set-result-for
    1138           0 :    context 'error
    1139           0 :    (cons '(bad-armor)
    1140           0 :          (epg-context-result-for context 'error))))
    1141             : 
    1142             : (defun epg--status-INV_RECP (context string)
    1143           0 :   (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
    1144           0 :       (epg-context-set-result-for
    1145           0 :        context 'error
    1146           0 :        (cons (list 'invalid-recipient
    1147           0 :                    (cons 'reason
    1148           0 :                          (string-to-number (match-string 1 string)))
    1149           0 :                    (cons 'requested
    1150           0 :                          (match-string 2 string)))
    1151           0 :              (epg-context-result-for context 'error)))))
    1152             : 
    1153             : (defun epg--status-INV_SGNR (context string)
    1154           0 :   (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
    1155           0 :       (epg-context-set-result-for
    1156           0 :        context 'error
    1157           0 :        (cons (list 'invalid-signer
    1158           0 :                    (cons 'reason
    1159           0 :                          (string-to-number (match-string 1 string)))
    1160           0 :                    (cons 'requested
    1161           0 :                          (match-string 2 string)))
    1162           0 :              (epg-context-result-for context 'error)))))
    1163             : 
    1164             : (defun epg--status-NO_RECP (context _string)
    1165           0 :   (epg-context-set-result-for
    1166           0 :    context 'error
    1167           0 :    (cons '(no-recipients)
    1168           0 :          (epg-context-result-for context 'error))))
    1169             : 
    1170             : (defun epg--status-NO_SGNR (context _string)
    1171           0 :   (epg-context-set-result-for
    1172           0 :    context 'error
    1173           0 :    (cons '(no-signers)
    1174           0 :          (epg-context-result-for context 'error))))
    1175             : 
    1176             : (defun epg--status-DELETE_PROBLEM (context string)
    1177           0 :   (if (string-match "\\`\\([0-9]+\\)" string)
    1178           0 :       (epg-context-set-result-for
    1179           0 :        context 'error
    1180           0 :        (cons (cons 'delete-problem
    1181           0 :                    (string-to-number (match-string 1 string)))
    1182           0 :              (epg-context-result-for context 'error)))))
    1183             : 
    1184             : (defun epg--status-SIG_CREATED (context string)
    1185           0 :   (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
    1186           0 : \\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
    1187           0 :       (epg-context-set-result-for
    1188           0 :        context 'sign
    1189           0 :        (cons (epg-make-new-signature
    1190           0 :               (cdr (assq (aref (match-string 1 string) 0)
    1191           0 :                          epg-new-signature-type-alist))
    1192           0 :               (string-to-number (match-string 2 string))
    1193           0 :               (string-to-number (match-string 3 string))
    1194           0 :               (string-to-number (match-string 4 string) 16)
    1195           0 :               (epg--time-from-seconds (match-string 5 string))
    1196           0 :               (substring string (match-end 0)))
    1197           0 :              (epg-context-result-for context 'sign)))))
    1198             : 
    1199             : (defun epg--status-KEY_CREATED (context string)
    1200           0 :   (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string)
    1201           0 :       (epg-context-set-result-for
    1202           0 :        context 'generate-key
    1203           0 :        (cons (list (cons 'type (string-to-char (match-string 1 string)))
    1204           0 :                    (cons 'fingerprint (match-string 2 string)))
    1205           0 :              (epg-context-result-for context 'generate-key)))))
    1206             : 
    1207             : (defun epg--status-KEY_NOT_CREATED (context _string)
    1208           0 :   (epg-context-set-result-for
    1209           0 :    context 'error
    1210           0 :    (cons '(key-not-created)
    1211           0 :          (epg-context-result-for context 'error))))
    1212             : 
    1213             : (defun epg--status-IMPORTED (_context string)
    1214           0 :   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
    1215           0 :       (let* ((key-id (match-string 1 string))
    1216           0 :              (user-id (match-string 2 string))
    1217           0 :              (entry (assoc key-id epg-user-id-alist)))
    1218           0 :         (condition-case nil
    1219           0 :             (setq user-id (epg--decode-coding-string
    1220           0 :                            (epg--decode-percent-escape user-id)
    1221           0 :                            'utf-8))
    1222           0 :           (error))
    1223           0 :         (if entry
    1224           0 :             (setcdr entry user-id)
    1225           0 :           (setq epg-user-id-alist (cons (cons key-id user-id)
    1226           0 :                                         epg-user-id-alist))))))
    1227             : 
    1228             : (defun epg--status-IMPORT_OK (context string)
    1229           0 :   (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
    1230           0 :       (let ((reason (string-to-number (match-string 1 string))))
    1231           0 :         (epg-context-set-result-for
    1232           0 :          context 'import-status
    1233           0 :          (cons (epg-make-import-status (if (match-beginning 2)
    1234           0 :                                            (match-string 3 string))
    1235             :                                        nil
    1236           0 :                                        (/= (logand reason 1) 0)
    1237           0 :                                        (/= (logand reason 2) 0)
    1238           0 :                                        (/= (logand reason 4) 0)
    1239           0 :                                        (/= (logand reason 8) 0)
    1240           0 :                                        (/= (logand reason 16) 0))
    1241           0 :                (epg-context-result-for context 'import-status))))))
    1242             : 
    1243             : (defun epg--status-IMPORT_PROBLEM (context string)
    1244           0 :   (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
    1245           0 :       (epg-context-set-result-for
    1246           0 :        context 'import-status
    1247           0 :        (cons (epg-make-import-status
    1248           0 :               (if (match-beginning 2)
    1249           0 :                   (match-string 3 string))
    1250           0 :               (string-to-number (match-string 1 string)))
    1251           0 :              (epg-context-result-for context 'import-status)))))
    1252             : 
    1253             : (defun epg--status-IMPORT_RES (context string)
    1254           0 :   (when (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
    1255             : \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
    1256           0 : \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
    1257           0 :     (epg-context-set-result-for
    1258           0 :      context 'import
    1259           0 :      (epg-make-import-result (string-to-number (match-string 1 string))
    1260           0 :                              (string-to-number (match-string 2 string))
    1261           0 :                              (string-to-number (match-string 3 string))
    1262           0 :                              (string-to-number (match-string 4 string))
    1263           0 :                              (string-to-number (match-string 5 string))
    1264           0 :                              (string-to-number (match-string 6 string))
    1265           0 :                              (string-to-number (match-string 7 string))
    1266           0 :                              (string-to-number (match-string 8 string))
    1267           0 :                              (string-to-number (match-string 9 string))
    1268           0 :                              (string-to-number (match-string 10 string))
    1269           0 :                              (string-to-number (match-string 11 string))
    1270           0 :                              (string-to-number (match-string 12 string))
    1271           0 :                              (string-to-number (match-string 13 string))
    1272           0 :                              (epg-context-result-for context 'import-status)))
    1273           0 :     (epg-context-set-result-for context 'import-status nil)))
    1274             : 
    1275             : (defun epg-passphrase-callback-function (context key-id _handback)
    1276             :   (declare (obsolete epa-passphrase-callback-function "23.1"))
    1277           0 :   (if (eq key-id 'SYM)
    1278           0 :       (read-passwd "Passphrase for symmetric encryption: "
    1279           0 :                    (eq (epg-context-operation context) 'encrypt))
    1280           0 :     (read-passwd
    1281           0 :      (if (eq key-id 'PIN)
    1282             :         "Passphrase for PIN: "
    1283           0 :        (let ((entry (assoc key-id epg-user-id-alist)))
    1284           0 :          (if entry
    1285           0 :              (format "Passphrase for %s %s: " key-id (cdr entry))
    1286           0 :            (format "Passphrase for %s: " key-id)))))))
    1287             : 
    1288             : (defun epg--list-keys-1 (context name mode)
    1289           0 :   (let ((args (append (if (epg-context-home-directory context)
    1290           0 :                           (list "--homedir"
    1291           0 :                                 (epg-context-home-directory context)))
    1292             :                       '("--with-colons" "--no-greeting" "--batch"
    1293             :                         "--with-fingerprint" "--with-fingerprint")
    1294           0 :                       (unless (eq (epg-context-protocol context) 'CMS)
    1295           0 :                         '("--fixed-list-mode"))))
    1296           0 :         (list-keys-option (if (memq mode '(t secret))
    1297             :                               "--list-secret-keys"
    1298           0 :                             (if (memq mode '(nil public))
    1299             :                                 "--list-keys"
    1300           0 :                               "--list-sigs")))
    1301             :         (coding-system-for-read 'binary)
    1302             :         keys string field index)
    1303           0 :     (if name
    1304           0 :         (progn
    1305           0 :           (unless (listp name)
    1306           0 :             (setq name (list name)))
    1307           0 :           (while name
    1308           0 :             (setq args (append args (list list-keys-option (car name)))
    1309           0 :                   name (cdr name))))
    1310           0 :       (setq args (append args (list list-keys-option))))
    1311           0 :     (with-temp-buffer
    1312           0 :       (apply #'call-process
    1313           0 :              (epg-context-program context)
    1314           0 :              nil (list t nil) nil args)
    1315           0 :       (goto-char (point-min))
    1316           0 :       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
    1317           0 :         (setq keys (cons (make-vector 15 nil) keys)
    1318           0 :               string (match-string 0)
    1319             :               index 0
    1320           0 :               field 0)
    1321           0 :         (while (and (< field (length (car keys)))
    1322           0 :                     (eq index
    1323           0 :                         (string-match "\\([^:]+\\)?:" string index)))
    1324           0 :           (setq index (match-end 0))
    1325           0 :           (aset (car keys) field (match-string 1 string))
    1326           0 :           (setq field (1+ field))))
    1327           0 :       (nreverse keys))))
    1328             : 
    1329             : (defun epg--make-sub-key-1 (line)
    1330           0 :   (epg-make-sub-key
    1331           0 :    (if (aref line 1)
    1332           0 :        (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
    1333           0 :    (delq nil
    1334           0 :          (mapcar (lambda (char) (cdr (assq char epg-key-capability-alist)))
    1335           0 :                  (aref line 11)))
    1336           0 :    (member (aref line 0) '("sec" "ssb"))
    1337           0 :    (string-to-number (aref line 3))
    1338           0 :    (string-to-number (aref line 2))
    1339           0 :    (aref line 4)
    1340           0 :    (epg--time-from-seconds (aref line 5))
    1341           0 :    (if (aref line 6)
    1342           0 :        (epg--time-from-seconds (aref line 6)))))
    1343             : 
    1344             : (defun epg-list-keys (context &optional name mode)
    1345             :   "Return a list of epg-key objects matched with NAME.
    1346             : If MODE is nil or `public', only public keyring should be searched.
    1347             : If MODE is t or `secret', only secret keyring should be searched.
    1348             : Otherwise, only public keyring should be searched and the key
    1349             : signatures should be included.
    1350             : NAME is either a string or a list of strings."
    1351           0 :   (let ((lines (epg--list-keys-1 context name mode))
    1352             :         keys cert pointer pointer-1 index string)
    1353           0 :     (while lines
    1354           0 :       (cond
    1355           0 :        ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
    1356           0 :         (setq cert (member (aref (car lines) 0) '("crt" "crs"))
    1357           0 :               keys (cons (epg-make-key
    1358           0 :                           (if (aref (car lines) 8)
    1359           0 :                               (cdr (assq (string-to-char (aref (car lines) 8))
    1360           0 :                                          epg-key-validity-alist))))
    1361           0 :                          keys))
    1362           0 :         (push (epg--make-sub-key-1 (car lines))
    1363           0 :               (epg-key-sub-key-list (car keys))))
    1364           0 :        ((member (aref (car lines) 0) '("sub" "ssb"))
    1365           0 :         (push (epg--make-sub-key-1 (car lines))
    1366           0 :               (epg-key-sub-key-list (car keys))))
    1367           0 :        ((equal (aref (car lines) 0) "uid")
    1368             :         ;; Decode the UID name as a backslash escaped UTF-8 string,
    1369             :         ;; generated by GnuPG/GpgSM.
    1370           0 :         (setq string (copy-sequence (aref (car lines) 9))
    1371           0 :               index 0)
    1372           0 :         (while (string-match "\"" string index)
    1373           0 :           (setq string (replace-match "\\\"" t t string)
    1374           0 :                 index (1+ (match-end 0))))
    1375           0 :         (condition-case nil
    1376           0 :             (setq string (epg--decode-coding-string
    1377           0 :                           (car (read-from-string (concat "\"" string "\"")))
    1378           0 :                           'utf-8))
    1379             :           (error
    1380           0 :            (setq string (aref (car lines) 9))))
    1381           0 :         (push (epg-make-user-id
    1382           0 :                (if (aref (car lines) 1)
    1383           0 :                    (cdr (assq (string-to-char (aref (car lines) 1))
    1384           0 :                               epg-key-validity-alist)))
    1385           0 :                (if cert
    1386           0 :                    (condition-case nil
    1387           0 :                        (epg-dn-from-string string)
    1388           0 :                      (error string))
    1389           0 :                  string))
    1390           0 :               (epg-key-user-id-list (car keys))))
    1391           0 :        ((equal (aref (car lines) 0) "fpr")
    1392           0 :         (setf (epg-sub-key-fingerprint (car (epg-key-sub-key-list (car keys))))
    1393           0 :               (aref (car lines) 9)))
    1394           0 :        ((equal (aref (car lines) 0) "sig")
    1395           0 :         (push
    1396           0 :          (epg-make-key-signature
    1397           0 :           (if (aref (car lines) 1)
    1398           0 :               (cdr (assq (string-to-char (aref (car lines) 1))
    1399           0 :                          epg-key-validity-alist)))
    1400           0 :           (string-to-number (aref (car lines) 3))
    1401           0 :           (aref (car lines) 4)
    1402           0 :           (epg--time-from-seconds (aref (car lines) 5))
    1403           0 :           (epg--time-from-seconds (aref (car lines) 6))
    1404           0 :           (aref (car lines) 9)
    1405           0 :           (string-to-number (aref (car lines) 10) 16)
    1406           0 :           (eq (aref (aref (car lines) 10) 2) ?x))
    1407           0 :          (epg-user-id-signature-list
    1408           0 :           (car (epg-key-user-id-list (car keys)))))))
    1409           0 :       (setq lines (cdr lines)))
    1410           0 :     (setq keys (nreverse keys)
    1411           0 :           pointer keys)
    1412           0 :     (while pointer
    1413           0 :       (epg--gv-nreverse (epg-key-sub-key-list (car pointer)))
    1414           0 :       (setq pointer-1 (epg--gv-nreverse (epg-key-user-id-list (car pointer))))
    1415           0 :       (while pointer-1
    1416           0 :         (epg--gv-nreverse (epg-user-id-signature-list (car pointer-1)))
    1417           0 :         (setq pointer-1 (cdr pointer-1)))
    1418           0 :       (setq pointer (cdr pointer)))
    1419           0 :     keys))
    1420             : 
    1421             : (eval-and-compile
    1422             :   (if (fboundp 'make-temp-file)
    1423             :       (defalias 'epg--make-temp-file 'make-temp-file)
    1424             :     (defvar temporary-file-directory)
    1425             :     ;; stolen from poe.el.
    1426             :     (defun epg--make-temp-file (prefix)
    1427             :       "Create a temporary file.
    1428             : The returned file name (created by appending some random characters at the end
    1429             : of PREFIX, and expanding against `temporary-file-directory' if necessary),
    1430             : is guaranteed to point to a newly created empty file.
    1431             : You can then use `write-region' to write new data into the file."
    1432             :       (let ((orig-modes (default-file-modes))
    1433             :             tempdir tempfile)
    1434             :         (setq prefix (expand-file-name prefix
    1435             :                                        (if (featurep 'xemacs)
    1436             :                                            (temp-directory)
    1437             :                                          temporary-file-directory)))
    1438             :         (unwind-protect
    1439             :             (let (file)
    1440             :               ;; First, create a temporary directory.
    1441             :               (set-default-file-modes #o700)
    1442             :               (while (condition-case ()
    1443             :                          (progn
    1444             :                            (setq tempdir (make-temp-name
    1445             :                                           (concat
    1446             :                                            (file-name-directory prefix)
    1447             :                                            "DIR")))
    1448             :                            ;; return nil or signal an error.
    1449             :                            (make-directory tempdir))
    1450             :                        ;; let's try again.
    1451             :                        (file-already-exists t)))
    1452             :               ;; Second, create a temporary file in the tempdir.
    1453             :               ;; There *is* a race condition between `make-temp-name'
    1454             :               ;; and `write-region', but we don't care it since we are
    1455             :               ;; in a private directory now.
    1456             :               (setq tempfile (make-temp-name (concat tempdir "/EMU")))
    1457             :               (write-region "" nil tempfile nil 'silent)
    1458             :               ;; Finally, make a hard-link from the tempfile.
    1459             :               (while (condition-case ()
    1460             :                          (progn
    1461             :                            (setq file (make-temp-name prefix))
    1462             :                            ;; return nil or signal an error.
    1463             :                            (add-name-to-file tempfile file))
    1464             :                        ;; let's try again.
    1465             :                        (file-already-exists t)))
    1466             :               file)
    1467             :           (set-default-file-modes orig-modes)
    1468             :           ;; Cleanup the tempfile.
    1469             :           (and tempfile
    1470             :                (file-exists-p tempfile)
    1471             :                (delete-file tempfile))
    1472             :           ;; Cleanup the tempdir.
    1473             :           (and tempdir
    1474             :                (file-directory-p tempdir)
    1475             :                (delete-directory tempdir)))))))
    1476             : 
    1477             : (defun epg--args-from-sig-notations (notations)
    1478           0 :   (apply #'nconc
    1479           0 :          (mapcar
    1480             :           (lambda (notation)
    1481           0 :             (if (and (epg-sig-notation-name notation)
    1482           0 :                      (not (epg-sig-notation-human-readable notation)))
    1483           0 :                 (error "Unreadable"))
    1484           0 :             (if (epg-sig-notation-name notation)
    1485           0 :                 (list "--sig-notation"
    1486           0 :                       (if (epg-sig-notation-critical notation)
    1487           0 :                           (concat "!" (epg-sig-notation-name notation)
    1488           0 :                                   "=" (epg-sig-notation-value notation))
    1489           0 :                         (concat (epg-sig-notation-name notation)
    1490           0 :                                 "=" (epg-sig-notation-value notation))))
    1491           0 :               (list "--sig-policy-url"
    1492           0 :                     (if (epg-sig-notation-critical notation)
    1493           0 :                         (concat "!" (epg-sig-notation-value notation))
    1494           0 :                       (epg-sig-notation-value notation)))))
    1495           0 :           notations)))
    1496             : 
    1497             : (defun epg-cancel (context)
    1498           0 :   (if (buffer-live-p (process-buffer (epg-context-process context)))
    1499           0 :       (with-current-buffer (process-buffer (epg-context-process context))
    1500           0 :         (epg-context-set-result-for
    1501           0 :          epg-context 'error
    1502           0 :          (cons '(quit)
    1503           0 :                (epg-context-result-for epg-context 'error)))))
    1504           0 :   (if (eq (process-status (epg-context-process context)) 'run)
    1505           0 :       (delete-process (epg-context-process context))))
    1506             : 
    1507             : (defun epg-start-decrypt (context cipher)
    1508             :   "Initiate a decrypt operation on CIPHER.
    1509             : CIPHER must be a file data object.
    1510             : 
    1511             : If you use this function, you will need to wait for the completion of
    1512             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    1513             : `epg-reset' to clear a temporary output file.
    1514             : If you are unsure, use synchronous version of this function
    1515             : `epg-decrypt-file' or `epg-decrypt-string' instead."
    1516           0 :   (unless (epg-data-file cipher)
    1517           0 :     (error "Not a file"))
    1518           0 :   (setf (epg-context-operation context) 'decrypt)
    1519           0 :   (setf (epg-context-result context) nil)
    1520           0 :   (epg--start context (list "--decrypt" "--" (epg-data-file cipher)))
    1521             :   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
    1522           0 :   (unless (eq (epg-context-protocol context) 'CMS)
    1523           0 :     (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
    1524             : 
    1525             : (defun epg--check-error-for-decrypt (context)
    1526           0 :   (let ((errors (epg-context-result-for context 'error)))
    1527           0 :     (if (epg-context-result-for context 'decryption-failed)
    1528           0 :         (signal 'epg-error
    1529           0 :                 (list "Decryption failed" (epg-errors-to-string errors))))
    1530           0 :     (unless (epg-context-result-for context 'decryption-okay)
    1531           0 :       (signal 'epg-error
    1532           0 :               (list "Can't decrypt" (epg-errors-to-string errors))))))
    1533             : 
    1534             : (defun epg-decrypt-file (context cipher plain)
    1535             :   "Decrypt a file CIPHER and store the result to a file PLAIN.
    1536             : If PLAIN is nil, it returns the result as a string."
    1537           0 :   (unwind-protect
    1538           0 :       (progn
    1539           0 :         (setf (epg-context-output-file context)
    1540           0 :               (or plain (epg--make-temp-file "epg-output")))
    1541           0 :         (epg-start-decrypt context (epg-make-data-from-file cipher))
    1542           0 :         (epg-wait-for-completion context)
    1543           0 :         (epg--check-error-for-decrypt context)
    1544           0 :         (unless plain
    1545           0 :           (epg-read-output context)))
    1546           0 :     (unless plain
    1547           0 :       (epg-delete-output-file context))
    1548           0 :     (epg-reset context)))
    1549             : 
    1550             : (defun epg-decrypt-string (context cipher)
    1551             :   "Decrypt a string CIPHER and return the plain text."
    1552           0 :   (let ((input-file (epg--make-temp-file "epg-input"))
    1553             :         (coding-system-for-write 'binary))
    1554           0 :     (unwind-protect
    1555           0 :         (progn
    1556           0 :           (write-region cipher nil input-file nil 'quiet)
    1557           0 :           (setf (epg-context-output-file context)
    1558           0 :                 (epg--make-temp-file "epg-output"))
    1559           0 :           (epg-start-decrypt context (epg-make-data-from-file input-file))
    1560           0 :           (epg-wait-for-completion context)
    1561           0 :           (epg--check-error-for-decrypt context)
    1562           0 :           (epg-read-output context))
    1563           0 :       (epg-delete-output-file context)
    1564           0 :       (if (file-exists-p input-file)
    1565           0 :           (delete-file input-file))
    1566           0 :       (epg-reset context))))
    1567             : 
    1568             : (defun epg-start-verify (context signature &optional signed-text)
    1569             :   "Initiate a verify operation on SIGNATURE.
    1570             : SIGNATURE and SIGNED-TEXT are a data object if they are specified.
    1571             : 
    1572             : For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
    1573             : For a normal or a cleartext signature, SIGNED-TEXT should be nil.
    1574             : 
    1575             : If you use this function, you will need to wait for the completion of
    1576             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    1577             : `epg-reset' to clear a temporary output file.
    1578             : If you are unsure, use synchronous version of this function
    1579             : `epg-verify-file' or `epg-verify-string' instead."
    1580           0 :   (setf (epg-context-operation context) 'verify)
    1581           0 :   (setf (epg-context-result context) nil)
    1582           0 :   (if signed-text
    1583             :       ;; Detached signature.
    1584           0 :       (if (epg-data-file signed-text)
    1585           0 :           (epg--start context (list "--verify" "--" (epg-data-file signature)
    1586           0 :                                    (epg-data-file signed-text)))
    1587           0 :         (epg--start context (list "--verify" "--" (epg-data-file signature)
    1588           0 :                                   "-"))
    1589           0 :         (if (eq (process-status (epg-context-process context)) 'run)
    1590           0 :             (process-send-string (epg-context-process context)
    1591           0 :                                  (epg-data-string signed-text)))
    1592           0 :         (if (eq (process-status (epg-context-process context)) 'run)
    1593           0 :             (process-send-eof (epg-context-process context))))
    1594             :     ;; Normal (or cleartext) signature.
    1595           0 :     (if (epg-data-file signature)
    1596           0 :         (epg--start context (if (eq (epg-context-protocol context) 'CMS)
    1597           0 :                                 (list "--verify" "--" (epg-data-file signature))
    1598           0 :                               (list "--" (epg-data-file signature))))
    1599           0 :       (epg--start context (if (eq (epg-context-protocol context) 'CMS)
    1600             :                               '("--verify" "-")
    1601           0 :                             '("-")))
    1602           0 :       (if (eq (process-status (epg-context-process context)) 'run)
    1603           0 :           (process-send-string (epg-context-process context)
    1604           0 :                                (epg-data-string signature)))
    1605           0 :       (if (eq (process-status (epg-context-process context)) 'run)
    1606           0 :           (process-send-eof (epg-context-process context))))))
    1607             : 
    1608             : (defun epg-verify-file (context signature &optional signed-text plain)
    1609             :   "Verify a file SIGNATURE.
    1610             : SIGNED-TEXT and PLAIN are also a file if they are specified.
    1611             : 
    1612             : For a detached signature, both SIGNATURE and SIGNED-TEXT should be
    1613             : string.  For a normal or a cleartext signature, SIGNED-TEXT should be
    1614             : nil.  In the latter case, if PLAIN is specified, the plaintext is
    1615             : stored into the file after successful verification.
    1616             : 
    1617             : Note that this function does not return verification result as t
    1618             : or nil, nor signal error on failure.  That's a design decision to
    1619             : handle the case where SIGNATURE has multiple signature.
    1620             : 
    1621             : To check the verification results, use `epg-context-result-for' as follows:
    1622             : 
    1623             : \(epg-context-result-for context \\='verify)
    1624             : 
    1625             : which will return a list of `epg-signature' object."
    1626           0 :   (unwind-protect
    1627           0 :       (progn
    1628           0 :         (setf (epg-context-output-file context)
    1629           0 :               (or plain (epg--make-temp-file "epg-output")))
    1630           0 :         (if signed-text
    1631           0 :             (epg-start-verify context
    1632           0 :                               (epg-make-data-from-file signature)
    1633           0 :                               (epg-make-data-from-file signed-text))
    1634           0 :           (epg-start-verify context
    1635           0 :                             (epg-make-data-from-file signature)))
    1636           0 :         (epg-wait-for-completion context)
    1637           0 :         (unless plain
    1638           0 :           (epg-read-output context)))
    1639           0 :     (unless plain
    1640           0 :       (epg-delete-output-file context))
    1641           0 :     (epg-reset context)))
    1642             : 
    1643             : (defun epg-verify-string (context signature &optional signed-text)
    1644             :   "Verify a string SIGNATURE.
    1645             : SIGNED-TEXT is a string if it is specified.
    1646             : 
    1647             : For a detached signature, both SIGNATURE and SIGNED-TEXT should be
    1648             : string.  For a normal or a cleartext signature, SIGNED-TEXT should be
    1649             : nil.  In the latter case, this function returns the plaintext after
    1650             : successful verification.
    1651             : 
    1652             : Note that this function does not return verification result as t
    1653             : or nil, nor signal error on failure.  That's a design decision to
    1654             : handle the case where SIGNATURE has multiple signature.
    1655             : 
    1656             : To check the verification results, use `epg-context-result-for' as follows:
    1657             : 
    1658             : \(epg-context-result-for context \\='verify)
    1659             : 
    1660             : which will return a list of `epg-signature' object."
    1661           0 :   (let ((coding-system-for-write 'binary)
    1662             :         input-file)
    1663           0 :     (unwind-protect
    1664           0 :         (progn
    1665           0 :           (setf (epg-context-output-file context)
    1666           0 :                 (epg--make-temp-file "epg-output"))
    1667           0 :           (if signed-text
    1668           0 :               (progn
    1669           0 :                 (setq input-file (epg--make-temp-file "epg-signature"))
    1670           0 :                 (write-region signature nil input-file nil 'quiet)
    1671           0 :                 (epg-start-verify context
    1672           0 :                                   (epg-make-data-from-file input-file)
    1673           0 :                                   (epg-make-data-from-string signed-text)))
    1674           0 :             (epg-start-verify context (epg-make-data-from-string signature)))
    1675           0 :           (epg-wait-for-completion context)
    1676           0 :           (epg-read-output context))
    1677           0 :       (epg-delete-output-file context)
    1678           0 :       (if (and input-file
    1679           0 :                (file-exists-p input-file))
    1680           0 :           (delete-file input-file))
    1681           0 :       (epg-reset context))))
    1682             : 
    1683             : (defun epg-start-sign (context plain &optional mode)
    1684             :   "Initiate a sign operation on PLAIN.
    1685             : PLAIN is a data object.
    1686             : 
    1687             : If optional 3rd argument MODE is t or `detached', it makes a detached signature.
    1688             : If it is nil or `normal', it makes a normal signature.
    1689             : Otherwise, it makes a cleartext signature.
    1690             : 
    1691             : If you use this function, you will need to wait for the completion of
    1692             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    1693             : `epg-reset' to clear a temporary output file.
    1694             : If you are unsure, use synchronous version of this function
    1695             : `epg-sign-file' or `epg-sign-string' instead."
    1696           0 :   (setf (epg-context-operation context) 'sign)
    1697           0 :   (setf (epg-context-result context) nil)
    1698           0 :   (unless (memq mode '(t detached nil normal)) ;i.e. cleartext
    1699           0 :     (epg-context-set-armor context nil)
    1700           0 :     (epg-context-set-textmode context nil))
    1701           0 :   (epg--start context
    1702           0 :              (append (list (if (memq mode '(t detached))
    1703             :                                "--detach-sign"
    1704           0 :                              (if (memq mode '(nil normal))
    1705             :                                  "--sign"
    1706           0 :                                "--clearsign")))
    1707           0 :                      (apply #'nconc
    1708           0 :                             (mapcar
    1709             :                              (lambda (signer)
    1710           0 :                                (list "-u"
    1711           0 :                                      (epg-sub-key-id
    1712           0 :                                       (car (epg-key-sub-key-list signer)))))
    1713           0 :                              (epg-context-signers context)))
    1714           0 :                      (epg--args-from-sig-notations
    1715           0 :                       (epg-context-sig-notations context))
    1716           0 :                      (if (epg-data-file plain)
    1717           0 :                          (list "--" (epg-data-file plain)))))
    1718             :   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
    1719           0 :   (unless (eq (epg-context-protocol context) 'CMS)
    1720           0 :     (epg-wait-for-status context '("BEGIN_SIGNING")))
    1721           0 :   (when (epg-data-string plain)
    1722           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    1723           0 :         (process-send-string (epg-context-process context)
    1724           0 :                              (epg-data-string plain)))
    1725           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    1726           0 :         (process-send-eof (epg-context-process context)))))
    1727             : 
    1728             : (defun epg-sign-file (context plain signature &optional mode)
    1729             :   "Sign a file PLAIN and store the result to a file SIGNATURE.
    1730             : If SIGNATURE is nil, it returns the result as a string.
    1731             : If optional 3rd argument MODE is t or `detached', it makes a detached signature.
    1732             : If it is nil or `normal', it makes a normal signature.
    1733             : Otherwise, it makes a cleartext signature."
    1734           0 :   (unwind-protect
    1735           0 :       (progn
    1736           0 :         (setf (epg-context-output-file context)
    1737           0 :               (or signature (epg--make-temp-file "epg-output")))
    1738           0 :         (epg-start-sign context (epg-make-data-from-file plain) mode)
    1739           0 :         (epg-wait-for-completion context)
    1740           0 :         (unless (epg-context-result-for context 'sign)
    1741           0 :           (let ((errors (epg-context-result-for context 'error)))
    1742           0 :             (signal 'epg-error
    1743           0 :                     (list "Sign failed" (epg-errors-to-string errors)))))
    1744           0 :         (unless signature
    1745           0 :           (epg-read-output context)))
    1746           0 :     (unless signature
    1747           0 :       (epg-delete-output-file context))
    1748           0 :     (epg-reset context)))
    1749             : 
    1750             : (defun epg-sign-string (context plain &optional mode)
    1751             :   "Sign a string PLAIN and return the output as string.
    1752             : If optional 3rd argument MODE is t or `detached', it makes a detached signature.
    1753             : If it is nil or `normal', it makes a normal signature.
    1754             : Otherwise, it makes a cleartext signature."
    1755           0 :   (let ((input-file
    1756           0 :          (unless (eq (epg-context-protocol context) 'CMS)
    1757           0 :            (epg--make-temp-file "epg-input")))
    1758             :         (coding-system-for-write 'binary))
    1759           0 :     (unwind-protect
    1760           0 :         (progn
    1761           0 :           (setf (epg-context-output-file context)
    1762           0 :                 (epg--make-temp-file "epg-output"))
    1763           0 :           (if input-file
    1764           0 :               (write-region plain nil input-file nil 'quiet))
    1765           0 :           (epg-start-sign context
    1766           0 :                           (if input-file
    1767           0 :                               (epg-make-data-from-file input-file)
    1768           0 :                             (epg-make-data-from-string plain))
    1769           0 :                           mode)
    1770           0 :           (epg-wait-for-completion context)
    1771           0 :           (unless (epg-context-result-for context 'sign)
    1772           0 :             (if (epg-context-result-for context 'error)
    1773           0 :                 (let ((errors (epg-context-result-for context 'error)))
    1774           0 :                   (signal 'epg-error
    1775           0 :                           (list "Sign failed" (epg-errors-to-string errors))))))
    1776           0 :           (epg-read-output context))
    1777           0 :       (epg-delete-output-file context)
    1778           0 :       (if input-file
    1779           0 :           (delete-file input-file))
    1780           0 :       (epg-reset context))))
    1781             : 
    1782             : (defun epg-start-encrypt (context plain recipients
    1783             :                                   &optional sign always-trust)
    1784             :   "Initiate an encrypt operation on PLAIN.
    1785             : PLAIN is a data object.
    1786             : If RECIPIENTS is nil, it performs symmetric encryption.
    1787             : 
    1788             : If you use this function, you will need to wait for the completion of
    1789             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    1790             : `epg-reset' to clear a temporary output file.
    1791             : If you are unsure, use synchronous version of this function
    1792             : `epg-encrypt-file' or `epg-encrypt-string' instead."
    1793           0 :   (setf (epg-context-operation context) 'encrypt)
    1794           0 :   (setf (epg-context-result context) nil)
    1795           0 :   (epg--start context
    1796           0 :              (append (if always-trust '("--always-trust"))
    1797           0 :                      (if recipients '("--encrypt") '("--symmetric"))
    1798           0 :                      (if sign '("--sign"))
    1799           0 :                      (if sign
    1800           0 :                          (apply #'nconc
    1801           0 :                                 (mapcar
    1802             :                                  (lambda (signer)
    1803           0 :                                    (list "-u"
    1804           0 :                                          (epg-sub-key-id
    1805           0 :                                           (car (epg-key-sub-key-list
    1806           0 :                                                 signer)))))
    1807           0 :                                  (epg-context-signers context))))
    1808           0 :                      (if sign
    1809           0 :                          (epg--args-from-sig-notations
    1810           0 :                           (epg-context-sig-notations context)))
    1811           0 :                      (apply #'nconc
    1812           0 :                             (mapcar
    1813             :                              (lambda (recipient)
    1814           0 :                                (list "-r"
    1815           0 :                                      (epg-sub-key-id
    1816           0 :                                       (car (epg-key-sub-key-list recipient)))))
    1817           0 :                              recipients))
    1818           0 :                      (if (epg-data-file plain)
    1819           0 :                          (list "--" (epg-data-file plain)))))
    1820             :   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
    1821           0 :   (unless (eq (epg-context-protocol context) 'CMS)
    1822           0 :     (epg-wait-for-status context
    1823           0 :                          (if sign '("BEGIN_SIGNING") '("BEGIN_ENCRYPTION"))))
    1824           0 :   (when (epg-data-string plain)
    1825           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    1826           0 :         (process-send-string (epg-context-process context)
    1827           0 :                              (epg-data-string plain)))
    1828           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    1829           0 :         (process-send-eof (epg-context-process context)))))
    1830             : 
    1831             : (defun epg-encrypt-file (context plain recipients
    1832             :                                  cipher &optional sign always-trust)
    1833             :   "Encrypt a file PLAIN and store the result to a file CIPHER.
    1834             : If CIPHER is nil, it returns the result as a string.
    1835             : If RECIPIENTS is nil, it performs symmetric encryption."
    1836           0 :   (unwind-protect
    1837           0 :       (progn
    1838           0 :         (setf (epg-context-output-file context)
    1839           0 :               (or cipher (epg--make-temp-file "epg-output")))
    1840           0 :         (epg-start-encrypt context (epg-make-data-from-file plain)
    1841           0 :                            recipients sign always-trust)
    1842           0 :         (epg-wait-for-completion context)
    1843           0 :         (let ((errors (epg-context-result-for context 'error)))
    1844           0 :           (if (and sign
    1845           0 :                    (not (epg-context-result-for context 'sign)))
    1846           0 :               (signal 'epg-error
    1847           0 :                       (list "Sign failed" (epg-errors-to-string errors))))
    1848           0 :           (if errors
    1849           0 :               (signal 'epg-error
    1850           0 :                       (list "Encrypt failed" (epg-errors-to-string errors)))))
    1851           0 :         (unless cipher
    1852           0 :           (epg-read-output context)))
    1853           0 :     (unless cipher
    1854           0 :       (epg-delete-output-file context))
    1855           0 :     (epg-reset context)))
    1856             : 
    1857             : (defun epg-encrypt-string (context plain recipients
    1858             :                                    &optional sign always-trust)
    1859             :   "Encrypt a string PLAIN.
    1860             : If RECIPIENTS is nil, it performs symmetric encryption."
    1861           0 :   (let ((input-file
    1862           0 :          (unless (or (not sign)
    1863           0 :                      (eq (epg-context-protocol context) 'CMS))
    1864           0 :            (epg--make-temp-file "epg-input")))
    1865             :         (coding-system-for-write 'binary))
    1866           0 :     (unwind-protect
    1867           0 :         (progn
    1868           0 :           (setf (epg-context-output-file context)
    1869           0 :                 (epg--make-temp-file "epg-output"))
    1870           0 :           (if input-file
    1871           0 :               (write-region plain nil input-file nil 'quiet))
    1872           0 :           (epg-start-encrypt context
    1873           0 :                              (if input-file
    1874           0 :                                  (epg-make-data-from-file input-file)
    1875           0 :                                (epg-make-data-from-string plain))
    1876           0 :                              recipients sign always-trust)
    1877           0 :           (epg-wait-for-completion context)
    1878           0 :           (let ((errors (epg-context-result-for context 'error)))
    1879           0 :             (if (and sign
    1880           0 :                      (not (epg-context-result-for context 'sign)))
    1881           0 :                 (signal 'epg-error
    1882           0 :                         (list "Sign failed" (epg-errors-to-string errors))))
    1883           0 :             (if errors
    1884           0 :                 (signal 'epg-error
    1885           0 :                         (list "Encrypt failed" (epg-errors-to-string errors)))))
    1886           0 :           (epg-read-output context))
    1887           0 :       (epg-delete-output-file context)
    1888           0 :       (if input-file
    1889           0 :           (delete-file input-file))
    1890           0 :       (epg-reset context))))
    1891             : 
    1892             : (defun epg-start-export-keys (context keys)
    1893             :   "Initiate an export keys operation.
    1894             : 
    1895             : If you use this function, you will need to wait for the completion of
    1896             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    1897             : `epg-reset' to clear a temporary output file.
    1898             : If you are unsure, use synchronous version of this function
    1899             : `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
    1900           0 :   (setf (epg-context-operation context) 'export-keys)
    1901           0 :   (setf (epg-context-result context) nil)
    1902           0 :   (epg--start context (cons "--export"
    1903           0 :                            (mapcar
    1904             :                             (lambda (key)
    1905           0 :                               (epg-sub-key-id
    1906           0 :                                (car (epg-key-sub-key-list key))))
    1907           0 :                             keys))))
    1908             : 
    1909             : (defun epg-export-keys-to-file (context keys file)
    1910             :   "Extract public KEYS."
    1911           0 :   (unwind-protect
    1912           0 :       (progn
    1913           0 :         (setf (epg-context-output-file context)
    1914           0 :               (or file (epg--make-temp-file "epg-output")))
    1915           0 :         (epg-start-export-keys context keys)
    1916           0 :         (epg-wait-for-completion context)
    1917           0 :         (let ((errors (epg-context-result-for context 'error)))
    1918           0 :           (if errors
    1919           0 :               (signal 'epg-error
    1920           0 :                       (list "Export keys failed"
    1921           0 :                             (epg-errors-to-string errors)))))
    1922           0 :         (unless file
    1923           0 :           (epg-read-output context)))
    1924           0 :     (unless file
    1925           0 :       (epg-delete-output-file context))
    1926           0 :     (epg-reset context)))
    1927             : 
    1928             : (defun epg-export-keys-to-string (context keys)
    1929             :   "Extract public KEYS and return them as a string."
    1930           0 :   (epg-export-keys-to-file context keys nil))
    1931             : 
    1932             : (defun epg-start-import-keys (context keys)
    1933             :   "Initiate an import keys operation.
    1934             : KEYS is a data object.
    1935             : 
    1936             : If you use this function, you will need to wait for the completion of
    1937             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    1938             : `epg-reset' to clear a temporary output file.
    1939             : If you are unsure, use synchronous version of this function
    1940             : `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
    1941           0 :   (setf (epg-context-operation context) 'import-keys)
    1942           0 :   (setf (epg-context-result context) nil)
    1943           0 :   (epg--start context (if (epg-data-file keys)
    1944           0 :                           (list "--import" "--" (epg-data-file keys))
    1945           0 :                         (list "--import")))
    1946           0 :   (when (epg-data-string keys)
    1947           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    1948           0 :         (process-send-string (epg-context-process context)
    1949           0 :                              (epg-data-string keys)))
    1950           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    1951           0 :         (process-send-eof (epg-context-process context)))))
    1952             : 
    1953             : (defun epg--import-keys-1 (context keys)
    1954           0 :   (unwind-protect
    1955           0 :       (progn
    1956           0 :         (epg-start-import-keys context keys)
    1957           0 :         (epg-wait-for-completion context)
    1958           0 :         (let ((errors (epg-context-result-for context 'error)))
    1959           0 :           (if errors
    1960           0 :               (signal 'epg-error
    1961           0 :                       (list "Import keys failed"
    1962           0 :                             (epg-errors-to-string errors))))))
    1963           0 :     (epg-reset context)))
    1964             : 
    1965             : (defun epg-import-keys-from-file (context keys)
    1966             :   "Add keys from a file KEYS."
    1967           0 :   (epg--import-keys-1 context (epg-make-data-from-file keys)))
    1968             : 
    1969             : (defun epg-import-keys-from-string (context keys)
    1970             :   "Add keys from a string KEYS."
    1971           0 :   (epg--import-keys-1 context (epg-make-data-from-string keys)))
    1972             : 
    1973             : (defun epg-start-receive-keys (context key-id-list)
    1974             :   "Initiate a receive key operation.
    1975             : KEY-ID-LIST is a list of key IDs.
    1976             : 
    1977             : If you use this function, you will need to wait for the completion of
    1978             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    1979             : `epg-reset' to clear a temporary output file.
    1980             : If you are unsure, use synchronous version of this function
    1981             : `epg-receive-keys' instead."
    1982           0 :   (setf (epg-context-operation context) 'receive-keys)
    1983           0 :   (setf (epg-context-result context) nil)
    1984           0 :   (epg--start context (cons "--recv-keys" key-id-list)))
    1985             : 
    1986             : (defun epg-receive-keys (context keys)
    1987             :   "Add keys from server.
    1988             : KEYS is a list of key IDs"
    1989           0 :   (unwind-protect
    1990           0 :       (progn
    1991           0 :         (epg-start-receive-keys context keys)
    1992           0 :         (epg-wait-for-completion context)
    1993           0 :         (let ((errors (epg-context-result-for context 'error)))
    1994           0 :           (if errors
    1995           0 :               (signal 'epg-error
    1996           0 :                       (list "Receive keys failed"
    1997           0 :                             (epg-errors-to-string errors))))))
    1998           0 :     (epg-reset context)))
    1999             : 
    2000             : (defalias 'epg-import-keys-from-server 'epg-receive-keys)
    2001             : 
    2002             : (defun epg-start-delete-keys (context keys &optional allow-secret)
    2003             :   "Initiate a delete keys operation.
    2004             : 
    2005             : If you use this function, you will need to wait for the completion of
    2006             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    2007             : `epg-reset' to clear a temporary output file.
    2008             : If you are unsure, use synchronous version of this function
    2009             : `epg-delete-keys' instead."
    2010           0 :   (setf (epg-context-operation context) 'delete-keys)
    2011           0 :   (setf (epg-context-result context) nil)
    2012           0 :   (epg--start context (cons (if allow-secret
    2013             :                                "--delete-secret-key"
    2014           0 :                              "--delete-key")
    2015           0 :                             (mapcar
    2016             :                              (lambda (key)
    2017           0 :                                (epg-sub-key-id
    2018           0 :                                 (car (epg-key-sub-key-list key))))
    2019           0 :                              keys))))
    2020             : 
    2021             : (defun epg-delete-keys (context keys &optional allow-secret)
    2022             :   "Delete KEYS from the key ring."
    2023           0 :   (unwind-protect
    2024           0 :       (progn
    2025           0 :         (epg-start-delete-keys context keys allow-secret)
    2026           0 :         (epg-wait-for-completion context)
    2027           0 :         (let ((errors (epg-context-result-for context 'error)))
    2028           0 :           (if errors
    2029           0 :               (signal 'epg-error
    2030           0 :                       (list "Delete keys failed"
    2031           0 :                             (epg-errors-to-string errors))))))
    2032           0 :     (epg-reset context)))
    2033             : 
    2034             : (defun epg-start-sign-keys (context keys &optional local)
    2035             :   "Initiate a sign keys operation.
    2036             : 
    2037             : If you use this function, you will need to wait for the completion of
    2038             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    2039             : `epg-reset' to clear a temporary output file.
    2040             : If you are unsure, use synchronous version of this function
    2041             : `epg-sign-keys' instead."
    2042             :   (declare (obsolete nil "23.1"))
    2043           0 :   (setf (epg-context-operation context) 'sign-keys)
    2044           0 :   (setf (epg-context-result context) nil)
    2045           0 :   (epg--start context (cons (if local
    2046             :                                "--lsign-key"
    2047           0 :                              "--sign-key")
    2048           0 :                            (mapcar
    2049             :                             (lambda (key)
    2050           0 :                               (epg-sub-key-id
    2051           0 :                                (car (epg-key-sub-key-list key))))
    2052           0 :                             keys))))
    2053             : 
    2054             : (defun epg-sign-keys (context keys &optional local)
    2055             :   "Sign KEYS from the key ring."
    2056             :   (declare (obsolete nil "23.1"))
    2057           0 :   (unwind-protect
    2058           0 :       (progn
    2059           0 :         (epg-start-sign-keys context keys local)
    2060           0 :         (epg-wait-for-completion context)
    2061           0 :         (let ((errors (epg-context-result-for context 'error)))
    2062           0 :           (if errors
    2063           0 :               (signal 'epg-error
    2064           0 :                       (list "Sign keys failed"
    2065           0 :                             (epg-errors-to-string errors))))))
    2066           0 :     (epg-reset context)))
    2067             : 
    2068             : (defun epg-start-generate-key (context parameters)
    2069             :   "Initiate a key generation.
    2070             : PARAMETERS is a string which specifies parameters of the generated key.
    2071             : See Info node `(gnupg) Unattended GPG key generation' in the
    2072             : GnuPG manual for the format.
    2073             : 
    2074             : If you use this function, you will need to wait for the completion of
    2075             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    2076             : `epg-reset' to clear a temporary output file.
    2077             : If you are unsure, use synchronous version of this function
    2078             : `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
    2079           0 :   (setf (epg-context-operation context) 'generate-key)
    2080           0 :   (setf (epg-context-result context) nil)
    2081           0 :   (if (epg-data-file parameters)
    2082           0 :       (epg--start context (list "--batch" "--gen-key" "--"
    2083           0 :                                (epg-data-file parameters)))
    2084           0 :     (epg--start context '("--batch" "--gen-key"))
    2085           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    2086           0 :         (process-send-string (epg-context-process context)
    2087           0 :                              (epg-data-string parameters)))
    2088           0 :     (if (eq (process-status (epg-context-process context)) 'run)
    2089           0 :         (process-send-eof (epg-context-process context)))))
    2090             : 
    2091             : (defun epg-generate-key-from-file (context parameters)
    2092             :   "Generate a new key pair.
    2093             : PARAMETERS is a file which tells how to create the key."
    2094           0 :   (unwind-protect
    2095           0 :       (progn
    2096           0 :         (epg-start-generate-key context (epg-make-data-from-file parameters))
    2097           0 :         (epg-wait-for-completion context)
    2098           0 :         (let ((errors (epg-context-result-for context 'error)))
    2099           0 :           (if errors
    2100           0 :               (signal 'epg-error
    2101           0 :                       (list "Generate key failed"
    2102           0 :                             (epg-errors-to-string errors))))))
    2103           0 :     (epg-reset context)))
    2104             : 
    2105             : (defun epg-generate-key-from-string (context parameters)
    2106             :   "Generate a new key pair.
    2107             : PARAMETERS is a string which tells how to create the key."
    2108           0 :   (unwind-protect
    2109           0 :       (progn
    2110           0 :         (epg-start-generate-key context (epg-make-data-from-string parameters))
    2111           0 :         (epg-wait-for-completion context)
    2112           0 :         (let ((errors (epg-context-result-for context 'error)))
    2113           0 :           (if errors
    2114           0 :               (signal 'epg-error
    2115           0 :                       (list "Generate key failed"
    2116           0 :                             (epg-errors-to-string errors))))))
    2117           0 :     (epg-reset context)))
    2118             : 
    2119             : (defun epg-start-edit-key (context key edit-callback handback)
    2120             :   "Initiate an edit operation on KEY.
    2121             : 
    2122             : EDIT-CALLBACK is called from process filter and takes 3
    2123             : arguments: the context, a status, an argument string, and the
    2124             : handback argument.
    2125             : 
    2126             : If you use this function, you will need to wait for the completion of
    2127             : `epg-gpg-program' by using `epg-wait-for-completion' and call
    2128             : `epg-reset' to clear a temporary output file.
    2129             : If you are unsure, use synchronous version of this function
    2130             : `epg-edit-key' instead."
    2131           0 :   (setf (epg-context-operation context) 'edit-key)
    2132           0 :   (setf (epg-context-result context) nil)
    2133           0 :   (setf (epg-context-edit-callback context) (cons edit-callback handback))
    2134           0 :   (epg--start context (list "--edit-key"
    2135           0 :                             (epg-sub-key-id
    2136           0 :                              (car (epg-key-sub-key-list key))))))
    2137             : 
    2138             : (defun epg-edit-key (context key edit-callback handback)
    2139             :   "Edit KEY in the keyring."
    2140           0 :   (unwind-protect
    2141           0 :       (progn
    2142           0 :         (epg-start-edit-key context key edit-callback handback)
    2143           0 :         (epg-wait-for-completion context)
    2144           0 :         (let ((errors (epg-context-result-for context 'error)))
    2145           0 :           (if errors
    2146           0 :               (signal 'epg-error
    2147           0 :                       (list "Edit key failed"
    2148           0 :                             (epg-errors-to-string errors))))))
    2149           0 :     (epg-reset context)))
    2150             : 
    2151             : (defun epg--decode-percent-escape (string)
    2152           0 :   (let ((index 0))
    2153           0 :     (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
    2154           0 :                          string index)
    2155           0 :       (if (match-beginning 2)
    2156           0 :           (setq string (replace-match "%" t t string)
    2157           0 :                 index (1- (match-end 0)))
    2158           0 :         (setq string (replace-match
    2159           0 :                       (string (string-to-number (match-string 3 string) 16))
    2160           0 :                       t t string)
    2161           0 :               index (- (match-end 0) 2))))
    2162           0 :     string))
    2163             : 
    2164             : (defun epg--decode-hexstring (string)
    2165           0 :   (let ((index 0))
    2166           0 :     (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
    2167           0 :       (setq string (replace-match (string (string-to-number
    2168           0 :                                            (match-string 0 string) 16))
    2169           0 :                                   t t string)
    2170           0 :             index (1- (match-end 0))))
    2171           0 :     string))
    2172             : 
    2173             : (defun epg--decode-quotedstring (string)
    2174           0 :   (let ((index 0))
    2175           0 :     (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
    2176             : \\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
    2177           0 :                          string index)
    2178           0 :       (if (match-beginning 2)
    2179           0 :           (setq string (replace-match "\\2" t nil string)
    2180           0 :                 index (1- (match-end 0)))
    2181           0 :         (if (match-beginning 3)
    2182           0 :             (setq string (replace-match (string (string-to-number
    2183           0 :                                                  (match-string 0 string) 16))
    2184           0 :                                         t t string)
    2185           0 :                   index (- (match-end 0) 2)))))
    2186           0 :     string))
    2187             : 
    2188             : (defun epg-dn-from-string (string)
    2189             :   "Parse STRING as LADPv3 Distinguished Names (RFC2253).
    2190             : The return value is an alist mapping from types to values."
    2191           0 :   (let ((index 0)
    2192           0 :         (length (length string))
    2193             :         alist type value group)
    2194           0 :     (while (< index length)
    2195           0 :       (if (eq index (string-match "[ \t\n\r]*" string index))
    2196           0 :           (setq index (match-end 0)))
    2197           0 :       (if (eq index (string-match
    2198             :                      "\\([0-9]+\\(\\.[0-9]+\\)*\\)[ \t\n\r]*=[ \t\n\r]*"
    2199           0 :                      string index))
    2200           0 :           (setq type (match-string 1 string)
    2201           0 :                 index (match-end 0))
    2202           0 :         (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
    2203           0 :                                     string index))
    2204           0 :             (setq type (match-string 1 string)
    2205           0 :                   index (match-end 0))))
    2206           0 :       (unless type
    2207           0 :         (error "Invalid type"))
    2208           0 :       (if (eq index (string-match
    2209             :                      "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
    2210           0 :                      string index))
    2211           0 :           (setq index (match-end 0)
    2212           0 :                 value (epg--decode-quotedstring (match-string 0 string)))
    2213           0 :         (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
    2214           0 :             (setq index (match-end 0)
    2215           0 :                   value (epg--decode-hexstring (match-string 1 string)))
    2216           0 :           (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
    2217           0 :                                       string index))
    2218           0 :               (setq index (match-end 0)
    2219           0 :                     value (epg--decode-quotedstring
    2220           0 :                            (match-string 0 string))))))
    2221           0 :       (if group
    2222           0 :           (if (stringp (car (car alist)))
    2223           0 :               (setcar alist (list (cons type value) (car alist)))
    2224           0 :             (setcar alist (cons (cons type value) (car alist))))
    2225           0 :         (if (consp (car (car alist)))
    2226           0 :             (setcar alist (nreverse (car alist))))
    2227           0 :         (setq alist (cons (cons type value) alist)
    2228             :               type nil
    2229           0 :               value nil))
    2230           0 :       (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
    2231           0 :           (setq index (match-end 0)
    2232           0 :                 group (eq (aref string (match-beginning 1)) ?+))))
    2233           0 :     (nreverse alist)))
    2234             : 
    2235             : (defun epg-decode-dn (alist)
    2236             :   "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
    2237             : Type names are resolved using `epg-dn-type-alist'."
    2238           0 :   (mapconcat
    2239             :    (lambda (rdn)
    2240           0 :      (if (stringp (car rdn))
    2241           0 :          (let ((entry (assoc (car rdn) epg-dn-type-alist)))
    2242           0 :            (if entry
    2243           0 :                (format "%s=%s" (cdr entry) (cdr rdn))
    2244           0 :              (format "%s=%s" (car rdn) (cdr rdn))))
    2245           0 :        (concat "(" (epg-decode-dn rdn) ")")))
    2246           0 :    alist
    2247           0 :    ", "))
    2248             : 
    2249             : (provide 'epg)
    2250             : 
    2251             : ;;; epg.el ends here

Generated by: LCOV version 1.12