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