epg.el

   1 ;;; epg.el --- the EasyPG Library
   2 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
   3 ;;   2005, 2006 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2006 Daiki Ueno
   5
   6 ;; Author: Daiki Ueno <ueno@unixuser.org>
   7 ;; Keywords: PGP, GnuPG
   8
   9 ;; This file is part of EasyPG.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Code:
  27
  28 (defgroup epg ()
  29   "The EasyPG Library")
  30
  31 (defcustom epg-gpg-program "gpg"
  32   "The `gpg' executable."
  33   :group 'epg
  34   :type 'string)
  35
  36 (defvar epg-user-id nil
  37   "GnuPG ID of your default identity.")
  38
  39 (defvar epg-user-id-alist nil
  40   "An alist mapping from key ID to user ID.")
  41
  42 (defvar epg-read-point nil)
  43 (defvar epg-pending-status-list nil)
  44 (defvar epg-key-id nil)
  45 (defvar epg-context nil)
  46 (defvar epg-debug nil)
  47
  48 ;; from gnupg/include/cipher.h
  49 (defconst epg-cipher-algorithm-alist
  50   '((0 . "NONE")
  51     (1 . "IDEA")
  52     (2 . "3DES")
  53     (3 . "CAST5")
  54     (4 . "BLOWFISH")
  55     (7 . "AES")
  56     (8 . "AES192")
  57     (9 . "AES256")
  58     (10 . "TWOFISH")
  59     (110 . "DUMMY")))
  60
  61 ;; from gnupg/include/cipher.h
  62 (defconst epg-pubkey-algorithm-alist
  63   '((1 . "RSA")
  64     (2 . "RSA_E")
  65     (3 . "RSA_S")
  66     (16 . "ELGAMAL_E")
  67     (17 . "DSA")
  68     (20 . "ELGAMAL")))
  69
  70 ;; from gnupg/include/cipher.h
  71 (defconst epg-digest-algorithm-alist
  72   '((1 . "MD5")
  73     (2 . "SHA1")
  74     (3 . "RMD160")
  75     (8 . "SHA256")
  76     (9 . "SHA384")
  77     (10 . "SHA512")))
  78
  79 ;; from gnupg/include/cipher.h
  80 (defconst epg-compress-algorithm-alist
  81   '((0 . "NONE")
  82     (1 . "ZIP")
  83     (2 . "ZLIB")
  84     (3 . "BZIP2")))
  85
  86 (defvar epg-key-validity-alist
  87   '((?o . unknown)
  88     (?i . invalid)
  89     (?d . disabled)
  90     (?r . revoked)
  91     (?e . expired)
  92     (?- . none)
  93     (?q . undefined)
  94     (?n . never)
  95     (?m . marginal)
  96     (?f . full)
  97     (?u . ultimate)))
  98
  99 (defvar epg-key-capablity-alist
 100   '((?e . encrypt)
 101     (?s . sign)
 102     (?c . certify)
 103     (?a . authentication)))
 104
 105 (defvar epg-prompt-alist nil)
 106
 107 (defun epg-make-data-from-file (file)
 108   "Make a data object from FILE."
 109   (vector file nil))
 110
 111 (defun epg-make-data-from-string (string)
 112   "Make a data object from STRING."
 113   (vector nil string))
 114
 115 (defun epg-data-file (data)
 116   "Return the file of DATA."
 117   (aref data 0))
 118
 119 (defun epg-data-string (data)
 120   "Return the string of DATA."
 121   (aref data 1))
 122
 123 (defun epg-make-context (&optional protocol armor textmode include-certs)
 124   "Return a context object."
 125   (vector protocol armor textmode include-certs
 126           #'epg-passphrase-callback-function
 127           #'epg-progress-callback-function
 128           nil nil nil nil))
 129
 130 (defun epg-context-protocol (context)
 131   "Return the protocol used within the context."
 132   (aref context 0))
 133
 134 (defun epg-context-armor (context)
 135   "Return t if the output shouled be ASCII armored in the CONTEXT context."
 136   (aref context 1))
 137
 138 (defun epg-context-textmode (context)
 139   "Return t if canonical text mode should be used in the CONTEXT context."
 140   (aref context 2))
 141
 142 (defun epg-context-include-certs (context)
 143   "Return how many certificates should be included in an S/MIME signed
 144 message."
 145   (aref context 3))
 146
 147 (defun epg-context-passphrase-callback (context)
 148   "Return the function used to query passphrase."
 149   (aref context 4))
 150
 151 (defun epg-context-progress-callback (context)
 152   "Return the function which handles progress update."
 153   (aref context 5))
 154
 155 (defun epg-context-signers (context)
 156   "Return the list of key-id for singning."
 157   (aref context 6))
 158
 159 (defun epg-context-process (context)
 160   "Return the process object of `epg-gpg-program'.
 161 This function is for internal use only."
 162   (aref context 7))
 163
 164 (defun epg-context-output-file (context)
 165   "Return the output file of `epg-gpg-program'.
 166 This function is for internal use only."
 167   (aref context 8))
 168
 169 (defun epg-context-result (context)
 170   "Return the result of the previous cryptographic operation."
 171   (aref context 9))
 172
 173 (defun epg-context-set-protocol (context protocol)
 174   "Set the protocol used within the context."
 175   (aset context 0 protocol))
 176
 177 (defun epg-context-set-armor (context armor)
 178   "Specify if the output shouled be ASCII armored in the CONTEXT context."
 179   (aset context 1 armor))
 180
 181 (defun epg-context-set-textmode (context textmode)
 182   "Specify if canonical text mode should be used in the CONTEXT context."
 183   (aset context 2 textmode))
 184
 185 (defun epg-context-set-include-certs (context include-certs)
 186  "Set how many certificates should be included in an S/MIME signed message."
 187   (aset context 3 include-certs))
 188
 189 (defun epg-context-set-passphrase-callback (context
 190                                                  passphrase-callback)
 191   "Set the function used to query passphrase."
 192   (aset context 4 passphrase-callback))
 193
 194 (defun epg-context-set-progress-callback (context progress-callback)
 195   "Set the function which handles progress update."
 196   (aset context 5 progress-callback))
 197
 198 (defun epg-context-set-signers (context signers)
 199  "Set the list of key-id for singning."
 200   (aset context 6 signers))
 201
 202 (defun epg-context-set-process (context process)
 203   "Set the process object of `epg-gpg-program'.
 204 This function is for internal use only."
 205   (aset context 7 process))
 206
 207 (defun epg-context-set-output-file (context output-file)
 208   "Set the output file of `epg-gpg-program'.
 209 This function is for internal use only."
 210   (aset context 8 output-file))
 211
 212 (defun epg-context-set-result (context result)
 213   "Set the result of the previous cryptographic operation."
 214   (aset context 9 result))
 215
 216 (defun epg-make-signature (status key-id user-id)
 217   "Return a signature object."
 218   (vector status key-id user-id nil nil))
 219
 220 (defun epg-signature-status (signature)
 221   "Return the status code of SIGNATURE."
 222   (aref signature 0))
 223
 224 (defun epg-signature-key-id (signature)
 225   "Return the key-id of SIGNATURE."
 226   (aref signature 1))
 227
 228 (defun epg-signature-user-id (signature)
 229   "Return the user-id of SIGNATURE."
 230   (aref signature 2))
 231
 232 (defun epg-signature-validity (signature)
 233   "Return the validity of SIGNATURE."
 234   (aref signature 3))
 235
 236 (defun epg-signature-fingerprint (signature)
 237   "Return the fingerprint of SIGNATURE."
 238   (aref signature 4))
 239
 240 (defun epg-signature-set-status (signature status)
 241  "Set the status code of SIGNATURE."
 242   (aset signature 0 status))
 243
 244 (defun epg-signature-set-key-id (signature key-id)
 245  "Set the key-id of SIGNATURE."
 246   (aset signature 1 key-id))
 247
 248 (defun epg-signature-set-user-id (signature user-id)
 249  "Set the user-id of SIGNATURE."
 250   (aset signature 2 user-id))
 251
 252 (defun epg-signature-set-validity (signature validity)
 253  "Set the validity of SIGNATURE."
 254   (aset signature 3 validity))
 255
 256 (defun epg-signature-set-fingerprint (signature fingerprint)
 257  "Set the fingerprint of SIGNATURE."
 258   (aset signature 4 fingerprint))
 259
 260 (defun epg-make-key (owner-trust)
 261   "Return a key object."
 262   (vector owner-trust nil nil))
 263
 264 (defun epg-key-owner-trust (key)
 265   "Return the owner trust of KEY."
 266   (aref key 0))
 267
 268 (defun epg-key-sub-key-list (key)
 269   "Return the sub key list of KEY."
 270   (aref key 1))
 271
 272 (defun epg-key-user-id-list (key)
 273   "Return the user ID list of KEY."
 274   (aref key 2))
 275
 276 (defun epg-key-set-sub-key-list (key sub-key-list)
 277   "Set the sub key list of KEY."
 278   (aset key 1 sub-key-list))
 279
 280 (defun epg-key-set-user-id-list (key user-id-list)
 281   "Set the user ID list of KEY."
 282   (aset key 2 user-id-list))
 283
 284 (defun epg-make-sub-key (validity capability secret algorithm length id
 285                                   creation-time expiration-time)
 286   "Return a sub key object."
 287   (vector validity capability secret algorithm length id creation-time
 288           expiration-time nil))
 289
 290 (defun epg-sub-key-validity (sub-key)
 291   "Return the validity of SUB-KEY."
 292   (aref sub-key 0))
 293
 294 (defun epg-sub-key-capability (sub-key)
 295   "Return the capability of SUB-KEY."
 296   (aref sub-key 1))
 297
 298 (defun epg-sub-key-secret (sub-key)
 299   "Return non-nil if SUB-KEY is a secret key."
 300   (aref sub-key 2))
 301
 302 (defun epg-sub-key-algorithm (sub-key)
 303   "Return the algorithm of SUB-KEY."
 304   (aref sub-key 3))
 305
 306 (defun epg-sub-key-length (sub-key)
 307   "Return the length of SUB-KEY."
 308   (aref sub-key 4))
 309
 310 (defun epg-sub-key-id (sub-key)
 311   "Return the ID of SUB-KEY."
 312   (aref sub-key 5))
 313
 314 (defun epg-sub-key-creation-time (sub-key)
 315   "Return the creation time of SUB-KEY."
 316   (aref sub-key 6))
 317
 318 (defun epg-sub-key-expiration-time (sub-key)
 319   "Return the expiration time of SUB-KEY."
 320   (aref sub-key 7))
 321
 322 (defun epg-sub-key-fingerprint (sub-key)
 323   "Return the fingerprint of SUB-KEY."
 324   (aref sub-key 8))
 325
 326 (defun epg-sub-key-set-fingerprint (sub-key fingerprint)
 327   "Set the fingerprint of SUB-KEY.
 328 This function is for internal use only."
 329   (aset sub-key 8 fingerprint))
 330
 331 (defun epg-make-user-id (validity name)
 332   "Return a user ID object."
 333   (vector validity name nil))
 334
 335 (defun epg-user-id-validity (user-id)
 336   "Return the validity of USER-ID."
 337   (aref user-id 0))
 338
 339 (defun epg-user-id-name (user-id)
 340   "Return the name of USER-ID."
 341   (aref user-id 1))
 342
 343 (defun epg-user-id-signature-list (user-id)
 344   "Return the signature list of USER-ID."
 345   (aref user-id 2))
 346
 347 (defun epg-user-id-set-signature-list (user-id signature-list)
 348   "Set the signature list of USER-ID."
 349   (aset user-id 2 signature-list))
 350
 351 (defun epg-context-result-for (context name)
 352   (cdr (assq name (epg-context-result context))))
 353
 354 (defun epg-context-set-result-for (context name value)
 355   (let* ((result (epg-context-result context))
 356          (entry (assq name result)))
 357     (if entry
 358         (setcdr entry value)
 359       (epg-context-set-result context (cons (cons name value) result)))))
 360
 361 (defun epg-start (context args)
 362   "Start `epg-gpg-program' in a subprocess with given ARGS."
 363   (let* ((args (append (list "--no-tty"
 364                              "--status-fd" "1"
 365                              "--command-fd" "0")
 366                        (if (epg-context-armor context) '("--armor"))
 367                        (if (epg-context-textmode context) '("--textmode"))
 368                        (if (epg-context-output-file context)
 369                            (list "--output" (epg-context-output-file context)))
 370                        args))
 371          (coding-system-for-write 'binary)
 372          process-connection-type
 373          (orig-mode (default-file-modes))
 374          (buffer (generate-new-buffer " *epg*"))
 375          process)
 376     (with-current-buffer buffer
 377       (make-local-variable 'epg-read-point)
 378       (setq epg-read-point (point-min))
 379       (make-local-variable 'epg-pending-status-list)
 380       (setq epg-pending-status-list nil)
 381       (make-local-variable 'epg-key-id)
 382       (setq epg-key-id nil)
 383       (make-local-variable 'epg-context)
 384       (setq epg-context context))
 385     (unwind-protect
 386         (progn
 387           (set-default-file-modes 448)
 388           (setq process
 389                 (apply #'start-process "epg" buffer epg-gpg-program args)))
 390       (set-default-file-modes orig-mode))
 391     (set-process-filter process #'epg-process-filter)
 392     (epg-context-set-process context process)))
 393
 394 (defun epg-process-filter (process input)
 395   (if epg-debug
 396       (save-excursion
 397         (set-buffer (get-buffer-create  " *epg-debug*"))
 398         (goto-char (point-max))
 399         (insert input)))
 400   (if (buffer-live-p (process-buffer process))
 401       (save-excursion
 402         (set-buffer (process-buffer process))
 403         (goto-char (point-max))
 404         (insert input)
 405         (goto-char epg-read-point)
 406         (beginning-of-line)
 407         (while (looking-at ".*\n")      ;the input line is finished
 408           (save-excursion
 409             (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
 410                 (let* ((status (match-string 1))
 411                        (string (match-string 2))
 412                        (symbol (intern-soft (concat "epg-status-" status))))
 413                   (if (member status epg-pending-status-list)
 414                       (setq epg-pending-status-list nil))
 415                   (if (and symbol
 416                            (fboundp symbol))
 417                       (funcall symbol process string)))))
 418           (forward-line))
 419         (setq epg-read-point (point)))))
 420
 421 (defun epg-read-output (context)
 422   (with-temp-buffer
 423     (if (fboundp 'set-buffer-multibyte)
 424         (set-buffer-multibyte nil))
 425     (if (file-exists-p (epg-context-output-file context))
 426         (let ((coding-system-for-read (if (epg-context-textmode context)
 427                                           'raw-text
 428                                         'binary)))
 429           (insert-file-contents (epg-context-output-file context))
 430           (buffer-string)))))
 431
 432 (defun epg-wait-for-status (context status-list)
 433   (with-current-buffer (process-buffer (epg-context-process context))
 434     (setq epg-pending-status-list status-list)
 435     (while (and (eq (process-status (epg-context-process context)) 'run)
 436                 epg-pending-status-list)
 437       (accept-process-output (epg-context-process context) 1))))
 438
 439 (defun epg-wait-for-completion (context)
 440   (if (eq (process-status (epg-context-process context)) 'run)
 441       (process-send-eof (epg-context-process context)))
 442   (while (eq (process-status (epg-context-process context)) 'run)
 443     ;; We can't use accept-process-output instead of sit-for here
 444     ;; because it may cause an interrupt during the sentinel execution.
 445     (sit-for 0.1)))
 446
 447 (defun epg-reset (context)
 448   (if (and (epg-context-process context)
 449            (buffer-live-p (process-buffer (epg-context-process context))))
 450       (kill-buffer (process-buffer (epg-context-process context))))
 451   (epg-context-set-process context nil))
 452
 453 (defun epg-delete-output-file (context)
 454   (if (and (epg-context-output-file context)
 455            (file-exists-p (epg-context-output-file context)))
 456       (delete-file (epg-context-output-file context))))
 457
 458 (defun epg-status-USERID_HINT (process string)
 459   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 460       (let* ((key-id (match-string 1 string))
 461              (user-id (match-string 2 string))
 462              (entry (assoc key-id epg-user-id-alist)))
 463         (if entry
 464             (setcdr entry user-id)
 465           (setq epg-user-id-alist (cons (cons key-id user-id)
 466                                         epg-user-id-alist))))))
 467
 468 (defun epg-status-NEED_PASSPHRASE (process string)
 469   (if (string-match "\\`\\([^ ]+\\)" string)
 470       (setq epg-key-id (match-string 1 string))))
 471
 472 (defun epg-status-NEED_PASSPHRASE_SYM (process string)
 473   (setq epg-key-id 'SYM))
 474
 475 (defun epg-status-NEED_PASSPHRASE_PIN (process string)
 476   (setq epg-key-id 'PIN))
 477
 478 (defun epg-status-GET_HIDDEN (process string)
 479   (let ((passphrase
 480          (funcall (if (consp (epg-context-passphrase-callback epg-context))
 481                       (car (epg-context-passphrase-callback epg-context))
 482                     (epg-context-passphrase-callback epg-context))
 483                   epg-key-id
 484                   (if (consp (epg-context-passphrase-callback epg-context))
 485                       (cdr (epg-context-passphrase-callback epg-context)))))
 486         string)
 487     (if passphrase
 488         (unwind-protect
 489             (progn
 490               (setq string (concat passphrase "\n"))
 491               (fillarray passphrase 0)
 492               (setq passphrase nil)
 493               (process-send-string process string))
 494           (if string
 495               (fillarray string 0))))))
 496
 497 (defun epg-status-GET_BOOL (process string)
 498   (let ((entry (assoc string epg-prompt-alist)))
 499     (if (y-or-n-p (if entry (cdr entry) (concat string "? ")))
 500         (process-send-string process "y\n")
 501       (process-send-string process "n\n"))))
 502
 503 (defun epg-status-GET_LINE (process string)
 504   (let* ((entry (assoc string epg-prompt-alist))
 505          (string (read-string (if entry (cdr entry) (concat string ": ")))))
 506     (process-send-string process (concat string "\n"))))
 507
 508 (defun epg-status-GOODSIG (process string)
 509   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 510       (epg-context-set-result-for
 511        epg-context
 512        'verify
 513        (cons (epg-make-signature 'good
 514                                  (match-string 1 string)
 515                                  (match-string 2 string))
 516              (epg-context-result-for epg-context 'verify)))))
 517
 518 (defun epg-status-EXPSIG (process string)
 519   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 520       (epg-context-set-result-for
 521        epg-context
 522        'verify
 523        (cons (epg-make-signature 'expired
 524                                  (match-string 1 string)
 525                                  (match-string 2 string))
 526              (epg-context-result-for epg-context 'verify)))))
 527
 528 (defun epg-status-EXPKEYSIG (process string)
 529   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 530       (epg-context-set-result-for
 531        epg-context
 532        'verify
 533        (cons (epg-make-signature 'expired-key
 534                                  (match-string 1 string)
 535                                  (match-string 2 string))
 536              (epg-context-result-for epg-context 'verify)))))
 537
 538 (defun epg-status-REVKEYSIG (process string)
 539   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 540       (epg-context-set-result-for
 541        epg-context
 542        'verify
 543        (cons (epg-make-signature 'revoked-key
 544                                  (match-string 1 string)
 545                                  (match-string 2 string))
 546              (epg-context-result-for epg-context 'verify)))))
 547
 548 (defun epg-status-BADSIG (process string)
 549   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 550       (epg-context-set-result-for
 551        epg-context
 552        'verify
 553        (cons (epg-make-signature 'bad
 554                                  (match-string 1 string)
 555                                  (match-string 2 string))
 556              (epg-context-result-for epg-context 'verify)))))
 557
 558 (defun epg-status-VALIDSIG (process string)
 559   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 560     (if (and signature
 561              (eq (epg-signature-status signature) 'good)
 562              (string-match "\\`\\([^ ]+\\) " string))
 563         (epg-signature-set-fingerprint signature (match-string 1 string)))))
 564
 565 (defun epg-status-TRUST_UNDEFINED (process string)
 566   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 567     (if (and signature
 568              (eq (epg-signature-status signature) 'good))
 569         (epg-signature-set-validity signature 'undefined))))
 570
 571 (defun epg-status-TRUST_NEVER (process string)
 572   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 573     (if (and signature
 574              (eq (epg-signature-status signature) 'good))
 575         (epg-signature-set-validity signature 'never))))
 576
 577 (defun epg-status-TRUST_MARGINAL (process string)
 578   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 579     (if (and signature
 580              (eq (epg-signature-status signature) 'marginal))
 581         (epg-signature-set-validity signature 'marginal))))
 582
 583 (defun epg-status-TRUST_FULLY (process string)
 584   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 585     (if (and signature
 586              (eq (epg-signature-status signature) 'good))
 587         (epg-signature-set-validity signature 'full))))
 588
 589 (defun epg-status-TRUST_ULTIMATE (process string)
 590   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 591     (if (and signature
 592              (eq (epg-signature-status signature) 'good))
 593         (epg-signature-set-validity signature 'ultimate))))
 594
 595 (defun epg-status-PROGRESS (process string)
 596   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
 597                     string)
 598       (funcall (if (consp (epg-context-progress-callback epg-context))
 599                    (car (epg-context-progress-callback epg-context))
 600                  (epg-context-progress-callback epg-context))
 601                (match-string 1 string)
 602                (match-string 2 string)
 603                (string-to-number (match-string 3 string))
 604                (string-to-number (match-string 4 string))
 605                (if (consp (epg-context-progress-callback epg-context))
 606                    (cdr (epg-context-progress-callback epg-context))))))
 607
 608 (defun epg-status-DECRYPTION_FAILED (process string)
 609   (epg-context-set-result-for
 610    epg-context 'error
 611    (cons 'decryption-failed
 612          (epg-context-result-for epg-context 'error))))
 613
 614 (defun epg-status-NODATA (process string)
 615   (epg-context-set-result-for
 616    epg-context 'error
 617    (cons (cons 'no-data (string-to-number string))
 618          (epg-context-result-for epg-context 'error))))
 619
 620 (defun epg-status-UNEXPECTED (process string)
 621   (epg-context-set-result-for
 622    epg-context 'error
 623    (cons (cons 'unexpected (string-to-number string))
 624          (epg-context-result-for epg-context 'error))))
 625
 626 (defun epg-status-KEYEXPIRED (process string)
 627   (epg-context-set-result-for
 628    epg-context 'error
 629    (cons (cons 'key-expired string)
 630          (epg-context-result-for epg-context 'error))))
 631
 632 (defun epg-status-KEYREVOKED (process string)
 633   (epg-context-set-result-for
 634    epg-context 'error
 635    (cons 'key-revoked
 636          (epg-context-result-for epg-context 'error))))
 637
 638 (defun epg-status-BADARMOR (process string)
 639   (epg-context-set-result-for
 640    epg-context 'error
 641    (cons 'bad-armor
 642          (epg-context-result-for epg-context 'error))))
 643
 644 (defun epg-passphrase-callback-function (key-id handback)
 645   (read-passwd
 646    (if (eq key-id 'SYM)
 647        "Passphrase for symmetric encryption: "
 648      (if (eq key-id 'PIN)
 649          "Passphrase for PIN: "
 650        (let ((entry (assoc key-id epg-user-id-alist)))
 651          (if entry
 652              (format "Passphrase for %s %s: " key-id (cdr entry))
 653            (format "Passphrase for %s: " key-id)))))))
 654
 655 (defun epg-progress-callback-function (what char current total handback)
 656   (message "%s: %d%%/%d%%" what current total))
 657
 658 (defun epg-configuration ()
 659   "Return a list of internal configuration parameters of `epg-gpg-program'."
 660   (let (config type)
 661     (with-temp-buffer
 662       (apply #'call-process epg-gpg-program nil (list t nil) nil
 663              '("--with-colons" "--list-config"))
 664       (goto-char (point-min))
 665       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
 666         (setq type (intern (match-string 1))
 667               config (cons (cons type
 668                                  (if (memq type
 669                                            '(pubkey cipher digest compress))
 670                                      (mapcar #'string-to-number
 671                                              (delete "" (split-string
 672                                                          (match-string 2)
 673                                                          ";")))
 674                                    (match-string 2)))
 675                            config))))
 676     config))
 677
 678 (defun epg-list-keys-1 (name mode)
 679   (let ((args (append (list "--with-colons" "--no-greeting" "--batch"
 680                             "--fixed-list-mode" "--with-fingerprint"
 681                             "--with-fingerprint"
 682                             (if mode "--list-secret-keys" "--list-keys"))
 683                       (if name (list name))))
 684         keys string field index)
 685     (with-temp-buffer
 686       (apply #'call-process epg-gpg-program nil (list t nil) nil args)
 687       (goto-char (point-min))
 688       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
 689         (setq keys (cons (make-vector 15 nil) keys)
 690               string (match-string 0)
 691               index 0
 692               field 0)
 693         (while (eq index
 694                    (string-match "\\([^:]+\\)?:" string index))
 695           (setq index (match-end 0))
 696           (aset (car keys) field (match-string 1 string))
 697           (setq field (1+ field))))
 698       (nreverse keys))))
 699
 700 (defun epg-make-sub-key-1 (line)
 701   (epg-make-sub-key
 702    (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist))
 703    (delq nil
 704          (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
 705                  (aref line 11)))
 706    (member (aref line 0) '("sec" "ssb"))
 707    (string-to-number (aref line 3))
 708    (string-to-number (aref line 2))
 709    (aref line 4)
 710    (aref line 5)
 711    (aref line 6)))
 712
 713 (defun epg-list-keys (&optional name mode)
 714   (let ((lines (epg-list-keys-1 name mode))
 715         keys)
 716     (while lines
 717       (cond
 718        ((member (aref (car lines) 0) '("pub" "sec"))
 719         (when (car keys)
 720           (epg-key-set-sub-key-list
 721            (car keys)
 722            (nreverse (epg-key-sub-key-list (car keys))))
 723           (epg-key-set-user-id-list
 724            (car keys)
 725            (nreverse (epg-key-user-id-list (car keys)))))
 726         (setq keys (cons (epg-make-key
 727                           (cdr (assq (string-to-char (aref (car lines) 8))
 728                                      epg-key-validity-alist)))
 729                          keys))
 730         (epg-key-set-sub-key-list
 731          (car keys)
 732          (cons (epg-make-sub-key-1 (car lines))
 733                (epg-key-sub-key-list (car keys)))))
 734        ((member (aref (car lines) 0) '("sub" "ssb"))
 735         (epg-key-set-sub-key-list
 736          (car keys)
 737          (cons (epg-make-sub-key-1 (car lines))
 738                (epg-key-sub-key-list (car keys)))))
 739        ((equal (aref (car lines) 0) "uid")
 740         (epg-key-set-user-id-list
 741          (car keys)
 742          (cons (epg-make-user-id
 743                 (cdr (assq (string-to-char (aref (car lines) 1))
 744                            epg-key-validity-alist))
 745                 (aref (car lines) 9))
 746                (epg-key-user-id-list (car keys)))))
 747        ((equal (aref (car lines) 0) "fpr")
 748         (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
 749                                      (aref (car lines) 9))))
 750       (setq lines (cdr lines)))
 751     (nreverse keys)))
 752
 753 (if (fboundp 'make-temp-file)
 754     (defalias 'epg-make-temp-file 'make-temp-file)
 755   ;; stolen from poe.el.
 756   (defun epg-make-temp-file (prefix)
 757     "Create a temporary file.
 758 The returned file name (created by appending some random characters at the end
 759 of PREFIX, and expanding against `temporary-file-directory' if necessary),
 760 is guaranteed to point to a newly created empty file.
 761 You can then use `write-region' to write new data into the file."
 762     (let (tempdir tempfile)
 763       (unwind-protect
 764           (let (file)
 765             ;; First, create a temporary directory.
 766             (while (condition-case ()
 767                        (progn
 768                          (setq tempdir (make-temp-name
 769                                         (concat
 770                                          (file-name-directory prefix)
 771                                          "DIR")))
 772                          ;; return nil or signal an error.
 773                          (make-directory tempdir))
 774                      ;; let's try again.
 775                      (file-already-exists t)))
 776             (set-file-modes tempdir 448)
 777             ;; Second, create a temporary file in the tempdir.
 778             ;; There *is* a race condition between `make-temp-name'
 779             ;; and `write-region', but we don't care it since we are
 780             ;; in a private directory now.
 781             (setq tempfile (make-temp-name (concat tempdir "/EMU")))
 782             (write-region "" nil tempfile nil 'silent)
 783             (set-file-modes tempfile 384)
 784             ;; Finally, make a hard-link from the tempfile.
 785             (while (condition-case ()
 786                        (progn
 787                          (setq file (make-temp-name prefix))
 788                          ;; return nil or signal an error.
 789                          (add-name-to-file tempfile file))
 790                      ;; let's try again.
 791                      (file-already-exists t)))
 792             file)
 793         ;; Cleanup the tempfile.
 794         (and tempfile
 795              (file-exists-p tempfile)
 796              (delete-file tempfile))
 797         ;; Cleanup the tempdir.
 798         (and tempdir
 799              (file-directory-p tempdir)
 800              (delete-directory tempdir))))))
 801
 802 ;;;###autoload
 803 (defun epg-start-decrypt (context cipher)
 804   "Initiate a decrypt operation on CIPHER.
 805 CIPHER is a data object.
 806
 807 If you use this function, you will need to wait for the completion of
 808 `epg-gpg-program' by using `epg-wait-for-completion' and call
 809 `epg-reset' to clear a temporaly output file.
 810 If you are unsure, use synchronous version of this function
 811 `epg-decrypt-file' or `epg-decrypt-string' instead."
 812   (unless (epg-data-file cipher)
 813     (error "Not a file"))
 814   (epg-context-set-result context nil)
 815   (epg-start context (list "--decrypt" (epg-data-file cipher)))
 816   (epg-wait-for-status context '("BEGIN_DECRYPTION")))
 817
 818 ;;;###autoload
 819 (defun epg-decrypt-file (context cipher plain)
 820   "Decrypt a file CIPHER and store the result to a file PLAIN.
 821 If PLAIN is nil, it returns the result as a string."
 822   (unwind-protect
 823       (progn
 824         (if plain
 825             (epg-context-set-output-file context plain)
 826           (epg-context-set-output-file context
 827                                        (epg-make-temp-file "epg-output")))
 828         (epg-start-decrypt context (epg-make-data-from-file cipher))
 829         (epg-wait-for-completion context)
 830         (if (epg-context-result-for context 'error)
 831             (error "Decryption failed"))
 832         (unless plain
 833           (epg-read-output context)))
 834     (unless plain
 835       (epg-delete-output-file context))
 836     (epg-reset context)))
 837
 838 ;;;###autoload
 839 (defun epg-decrypt-string (context cipher)
 840   "Decrypt a string CIPHER and return the plain text."
 841   (let ((input-file (epg-make-temp-file "epg-input"))
 842         (coding-system-for-write 'binary))
 843     (unwind-protect
 844         (progn
 845           (write-region cipher nil input-file)
 846           (epg-context-set-output-file context
 847                                        (epg-make-temp-file "epg-output"))
 848           (epg-start-decrypt context (epg-make-data-from-file input-file))
 849           (epg-wait-for-completion context)
 850           (if (epg-context-result-for context 'error)
 851               (error "Decryption failed"))
 852           (epg-read-output context))
 853       (epg-delete-output-file context)
 854       (if (file-exists-p input-file)
 855           (delete-file input-file))
 856       (epg-reset context))))
 857
 858 ;;;###autoload
 859 (defun epg-start-verify (context signature &optional signed-text)
 860   "Initiate a verify operation on SIGNATURE.
 861 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
 862
 863 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
 864 For a normal or a clear text signature, SIGNED-TEXT should be nil.
 865
 866 If you use this function, you will need to wait for the completion of
 867 `epg-gpg-program' by using `epg-wait-for-completion' and call
 868 `epg-reset' to clear a temporaly output file.
 869 If you are unsure, use synchronous version of this function
 870 `epg-verify-file' or `epg-verify-string' instead."
 871   (epg-context-set-result context nil)
 872   (if signed-text
 873       ;; Detached signature.
 874       (if (epg-data-file signed-text)
 875           (epg-start context (list "--verify" (epg-data-file signature)
 876                                    (epg-data-file signed-text)))
 877         (epg-start context (list "--verify" (epg-data-file signature) "-"))
 878         (if (eq (process-status (epg-context-process context)) 'run)
 879             (process-send-string (epg-context-process context)
 880                                  (epg-data-string signed-text))))
 881     ;; Normal (or cleartext) signature.
 882     (if (epg-data-file signature)
 883         (epg-start context (list "--verify" (epg-data-file signature)))
 884       (epg-start context (list "--verify"))
 885       (if (eq (process-status (epg-context-process context)) 'run)
 886           (process-send-string (epg-context-process context)
 887                                (epg-data-string signature))))))
 888
 889 ;;;###autoload
 890 (defun epg-verify-file (context signature &optional signed-text plain)
 891   "Verify a file SIGNATURE.
 892 SIGNED-TEXT and PLAIN are also a file if they are specified.
 893
 894 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
 895 For a normal or a clear text signature, SIGNED-TEXT should be nil."
 896   (unwind-protect
 897       (progn
 898         (if plain
 899             (epg-context-set-output-file context plain)
 900           (epg-context-set-output-file context
 901                                        (epg-make-temp-file "epg-output")))
 902         (if signed-text
 903             (epg-start-verify context
 904                               (epg-make-data-from-file signature)
 905                               (epg-make-data-from-file signed-text))
 906           (epg-start-verify context
 907                             (epg-make-data-from-file signature)))
 908         (epg-wait-for-completion context)
 909         (unless plain
 910           (epg-read-output context)))
 911     (unless plain
 912       (epg-delete-output-file context))
 913     (epg-reset context)))
 914
 915 ;;;###autoload
 916 (defun epg-verify-string (context signature &optional signed-text)
 917   "Verify a string SIGNATURE.
 918 SIGNED-TEXT is a string if it is specified.
 919
 920 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
 921 For a normal or a clear text signature, SIGNED-TEXT should be nil."
 922   (let ((coding-system-for-write 'binary)
 923         input-file)
 924     (unwind-protect
 925         (progn
 926           (epg-context-set-output-file context
 927                                        (epg-make-temp-file "epg-output"))
 928           (if signed-text
 929               (progn
 930                 (setq input-file (epg-make-temp-file "epg-signature"))
 931                 (write-region signature nil input-file)
 932                 (epg-start-verify context
 933                                   (epg-make-data-from-file input-file)
 934                                   (epg-make-data-from-string signed-text)))
 935             (epg-start-verify context (epg-make-data-from-string signature)))
 936           (epg-wait-for-completion context)
 937           (epg-read-output context))
 938       (epg-delete-output-file context)
 939       (if (and input-file
 940                (file-exists-p input-file))
 941           (delete-file input-file))
 942       (epg-reset context))))
 943
 944 ;;;###autoload
 945 (defun epg-start-sign (context plain &optional mode)
 946   "Initiate a sign operation on PLAIN.
 947 PLAIN is a data object.
 948
 949 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
 950 If MODE is t or 'detached, it makes a detached signature.
 951 Otherwise, it makes a normal signature.
 952
 953 If you use this function, you will need to wait for the completion of
 954 `epg-gpg-program' by using `epg-wait-for-completion' and call
 955 `epg-reset' to clear a temporaly output file.
 956 If you are unsure, use synchronous version of this function
 957 `epg-sign-file' or `epg-sign-string' instead."
 958   (epg-context-set-result context nil)
 959   (epg-start context
 960              (append (list (if (eq mode 'clearsign)
 961                                "--clearsign"
 962                              (if (or (eq mode t) (eq mode 'detached))
 963                                  "--detach-sign"
 964                                "--sign")))
 965                      (apply #'nconc
 966                             (mapcar (lambda (signer)
 967                                       (list "-u" signer))
 968                                     (epg-context-signers context)))
 969                      (if (epg-data-file plain)
 970                          (list (epg-data-file plain)))))
 971   (epg-wait-for-status context '("BEGIN_SIGNING"))
 972   (if (and (epg-data-string plain)
 973            (eq (process-status (epg-context-process context)) 'run))
 974       (process-send-string (epg-context-process context)
 975                            (epg-data-string plain))))
 976
 977 ;;;###autoload
 978 (defun epg-sign-file (context plain signature &optional mode)
 979   "Sign a file PLAIN and store the result to a file SIGNATURE.
 980 If SIGNATURE is nil, it returns the result as a string.
 981 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
 982 If MODE is t or 'detached, it makes a detached signature.
 983 Otherwise, it makes a normal signature."
 984   (unwind-protect
 985       (progn
 986         (if signature
 987             (epg-context-set-output-file context signature)
 988           (epg-context-set-output-file context
 989                                        (epg-make-temp-file "epg-output")))
 990         (epg-start-sign context (epg-make-data-from-file plain) mode)
 991         (epg-wait-for-completion context)
 992         (if (epg-context-result-for context 'error)
 993             (error "Sign failed"))
 994         (unless signature
 995           (epg-read-output context)))
 996     (unless signature
 997       (epg-delete-output-file context))
 998     (epg-reset context)))
 999
1000 ;;;###autoload
1001 (defun epg-sign-string (context plain &optional mode)
1002   "Sign a string PLAIN and return the output as string.
1003 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
1004 If MODE is t or 'detached, it makes a detached signature.
1005 Otherwise, it makes a normal signature."
1006   (unwind-protect
1007       (progn
1008         (epg-context-set-output-file context
1009                                      (epg-make-temp-file "epg-output"))
1010         (epg-start-sign context (epg-make-data-from-string plain) mode)
1011         (epg-wait-for-completion context)
1012         (if (epg-context-result-for context 'error)
1013             (error "Sign failed"))
1014         (epg-read-output context))
1015     (epg-delete-output-file context)
1016     (epg-reset context)))
1017
1018 ;;;###autoload
1019 (defun epg-start-encrypt (context plain recipients
1020                                   &optional sign always-trust)
1021   "Initiate an encrypt operation on PLAIN.
1022 PLAIN is a data object.
1023 If RECIPIENTS is nil, it performs symmetric encryption.
1024
1025 If you use this function, you will need to wait for the completion of
1026 `epg-gpg-program' by using `epg-wait-for-completion' and call
1027 `epg-reset' to clear a temporaly output file.
1028 If you are unsure, use synchronous version of this function
1029 `epg-encrypt-file' or `epg-encrypt-string' instead."
1030   (epg-context-set-result context nil)
1031   (epg-start context
1032              (append (if always-trust '("--always-trust"))
1033                      (if recipients '("--encrypt") '("--symmetric"))
1034                      (if sign
1035                          (cons "--sign"
1036                                (apply #'nconc
1037                                       (mapcar (lambda (signer)
1038                                                 (list "-u" signer))
1039                                               (epg-context-signers context)))))
1040                      (apply #'nconc
1041                             (mapcar (lambda (recipient)
1042                                       (list "-r" recipient))
1043                                     recipients))
1044                      (if (epg-data-file plain)
1045                          (list (epg-data-file plain)))))
1046   (if sign
1047       (epg-wait-for-status context '("BEGIN_SIGNING"))
1048     (if (null recipients)
1049         (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
1050   (if (and (epg-data-string plain)
1051            (eq (process-status (epg-context-process context)) 'run))
1052       (process-send-string (epg-context-process context)
1053                            (epg-data-string plain))))
1054
1055 ;;;###autoload
1056 (defun epg-encrypt-file (context plain recipients
1057                                  cipher &optional sign always-trust)
1058   "Encrypt a file PLAIN and store the result to a file CIPHER.
1059 If CIPHER is nil, it returns the result as a string.
1060 If RECIPIENTS is nil, it performs symmetric encryption."
1061   (unwind-protect
1062       (progn
1063         (if cipher
1064             (epg-context-set-output-file context cipher)
1065           (epg-context-set-output-file context
1066                                        (epg-make-temp-file "epg-output")))
1067         (epg-start-encrypt context (epg-make-data-from-file plain)
1068                            recipients sign always-trust)
1069         (epg-wait-for-completion context)
1070         (if (epg-context-result-for context 'error)
1071             (error "Encrypt failed"))
1072         (unless cipher
1073           (epg-read-output context)))
1074     (unless cipher
1075       (epg-delete-output-file context))
1076     (epg-reset context)))
1077
1078 ;;;###autoload
1079 (defun epg-encrypt-string (context plain recipients
1080                                    &optional sign always-trust)
1081   "Encrypt a string PLAIN.
1082 If RECIPIENTS is nil, it performs symmetric encryption."
1083   (unwind-protect
1084       (progn
1085         (epg-context-set-output-file context
1086                                      (epg-make-temp-file "epg-output"))
1087         (epg-start-encrypt context (epg-make-data-from-string plain)
1088                            recipients sign always-trust)
1089         (epg-wait-for-completion context)
1090         (if (epg-context-result-for context 'error)
1091             (error "Encrypt failed"))
1092         (epg-read-output context))
1093     (epg-delete-output-file context)
1094     (epg-reset context)))
1095
1096 ;;;###autoload
1097 (defun epg-start-export-keys (context pattern)
1098   "Initiate an export keys operation.
1099
1100 If you use this function, you will need to wait for the completion of
1101 `epg-gpg-program' by using `epg-wait-for-completion' and call
1102 `epg-reset' to clear a temporaly output file.
1103 If you are unsure, use synchronous version of this function
1104 `epg-export-keys' instead."
1105   (epg-context-set-result context nil)
1106   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
1107   (epg-start context (list "--export" pattern)))
1108
1109 ;;;###autoload
1110 (defun epg-export-keys (context pattern)
1111   "Extract public keys matched with PATTERN and return them."
1112   (unwind-protect
1113       (progn
1114         (epg-start-export-keys context pattern)
1115         (epg-wait-for-completion context)
1116         (if (epg-context-result-for context 'error)
1117             (error "Export keys failed"))
1118         (epg-read-output context))
1119     (epg-reset context)))
1120
1121 ;;;###autoload
1122 (defun epg-start-import-keys (context keys)
1123   "Initiate an import keys operation.
1124 KEYS is a data object.
1125
1126 If you use this function, you will need to wait for the completion of
1127 `epg-gpg-program' by using `epg-wait-for-completion' and call
1128 `epg-reset' to clear a temporaly output file.
1129 If you are unsure, use synchronous version of this function
1130 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
1131   (epg-context-set-result context nil)
1132   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
1133   (epg-start context (append (list "--import") (epg-data-file keys)))
1134   (if (and (epg-data-string keys)
1135            (eq (process-status (epg-context-process context)) 'run))
1136       (process-send-string (epg-context-process context)
1137                            (epg-data-string keys))))
1138
1139 (defun epg-import-keys-1 (context keys)
1140   (unwind-protect
1141       (progn
1142         (epg-start-import-keys context keys)
1143         (epg-wait-for-completion context)
1144         (if (epg-context-result-for context 'error)
1145             (error "Import keys failed"))
1146         (epg-read-output context))
1147     (epg-reset context)))
1148
1149 ;;;###autoload
1150 (defun epg-import-keys-from-file (context keys)
1151   "Add keys from a file KEYS."
1152   (epg-import-keys-1 context (epg-make-data-from-file keys)))
1153
1154 ;;;###autoload
1155 (defun epg-import-keys-from-string (context keys)
1156   "Add keys from a string KEYS."
1157   (epg-import-keys-1 context (epg-make-data-from-string keys)))
1158
1159 (provide 'epg)
1160
1161 ;;; epg.el ends here