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