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