X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=330e7c46926c58c809d3bb1d6de8d2b1b20a02ba;hb=b1d05ceee17137266c8a4729bb0180fe265baae4;hp=027c13ddacc3c7811903daa85ee1bc5e5792ba93;hpb=596cad22b4e14b111af4d337dc0de1af2ad53708;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index 027c13d..330e7c4 100644 --- a/epg.el +++ b/epg.el @@ -58,13 +58,12 @@ This is used by `epg-list-keys'.") "The schema of keylisting output whose type is \"uid\". This is used by `epg-list-keys'.") -(defun epg-make-context (&optional protocol armor textmode include-certs - process output-file result) +(defun epg-make-context (&optional protocol armor textmode include-certs) "Return a context object." (vector protocol armor textmode include-certs - (list #'epg-passphrase-callback) - (list #'epg-progress-callback) - nil process output-file result)) + (cons #'epg-passphrase-callback-function nil) + (cons #'epg-progress-callback-function nil) + nil nil nil nil)) (defun epg-context-protocol (context) "Return the protocol used within the context." @@ -83,11 +82,11 @@ This is used by `epg-list-keys'.") message." (aref context 3)) -(defun epg-context-passphrase-callback (context) +(defun epg-context-passphrase-callback-info (context) "Return the function used to query passphrase." (aref context 4)) -(defun epg-context-progress-callback (context) +(defun epg-context-progress-callback-info (context) "Return the function which handles progress update." (aref context 5)) @@ -105,9 +104,9 @@ This function is for internal use only." This function is for internal use only." (aref context 8)) -(defun epg-context-result (context name) +(defun epg-context-result (context) "Return the result of the previous cryptographic operation." - (cdr (assq name (aref context 9)))) + (aref context 9)) (defun epg-context-set-protocol (context protocol) "Set the protocol used within the context." @@ -125,15 +124,14 @@ This function is for internal use only." "Set how many certificates should be included in an S/MIME signed message." (aset context 3 include-certs)) -(defun epg-context-set-passphrase-callback (context passphrase-callback - &optional handback) +(defun epg-context-set-passphrase-callback-info (context + passphrase-callback-info) "Set the function used to query passphrase." - (aset context 4 (cons passphrase-callback handback))) + (aset context 4 passphrase-callback-info)) -(defun epg-context-set-progress-callback (context progress-callback - &optional handback) +(defun epg-context-set-progress-callback-info (context progress-callback-info) "Set the function which handles progress update." - (aset context 5 (cons progress-callback handback))) + (aset context 5 progress-callback-info)) (defun epg-context-set-signers (context signers) "Set the list of key-id for singning." @@ -149,12 +147,9 @@ This function is for internal use only." This function is for internal use only." (aset context 8 output-file)) -(defun epg-context-set-result (context name result) +(defun epg-context-set-result (context result) "Set the result of the previous cryptographic operation." - (let ((entry (assq name (aref context 9)))) - (if entry - (setcdr entry result) - (aset context 9 (cons (cons name result) (aref context 9)))))) + (aset context 9 result)) (defun epg-make-signature (status key-id user-id) "Return a signature object." @@ -192,6 +187,16 @@ This function is for internal use only." "Set the validity of SIGNATURE." (aset signature 3 validity)) +(defun epg-context-result-for (context name) + (cdr (assq name (epg-context-result context)))) + +(defun epg-context-set-result-for (context name value) + (let* ((result (epg-context-result context)) + (entry (assq name result))) + (if entry + (setcdr entry value) + (epg-context-set-result context (cons (cons name value) result))))) + (defun epg-start (context args) "Start `epg-gpg-program' in a subprocess with given ARGS." (let* ((args (append (list "--no-tty" @@ -255,11 +260,12 @@ This function is for internal use only." (defun epg-read-output (context) (with-temp-buffer - (set-buffer-multibyte nil) + (if (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) (if (file-exists-p (epg-context-output-file context)) - (let ((coding-system-for-read (if (epg-context-output-file context) + (let ((coding-system-for-read (if (epg-context-textmode context) 'raw-text - 'binary))) + 'binary))) (insert-file-contents (epg-context-output-file context)) (buffer-string))))) @@ -271,7 +277,8 @@ This function is for internal use only." (accept-process-output (epg-context-process context) 1)))) (defun epg-wait-for-completion (context) - (process-send-eof (epg-context-process context)) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context))) (while (eq (process-status (epg-context-process context)) 'run) ;; We can't use accept-process-output instead of sit-for here ;; because it may cause an interrupt during the sentinel execution. @@ -307,120 +314,160 @@ This function is for internal use only." (setq epg-key-id 'PIN)) (defun epg-status-GET_HIDDEN (process string) - (let ((passphrase (funcall - (car (epg-context-passphrase-callback epg-context)) - epg-key-id - (cdr (epg-context-passphrase-callback epg-context))))) - (unwind-protect - (if passphrase - (process-send-string process (concat passphrase "\n"))) - (fillarray passphrase 0)))) + (let ((passphrase + (funcall (car (epg-context-passphrase-callback-info epg-context)) + epg-key-id + (cdr (epg-context-passphrase-callback-info epg-context)))) + string) + (if passphrase + (unwind-protect + (progn + (setq string (concat passphrase "\n")) + (fillarray passphrase 0) + (setq passphrase nil) + (process-send-string process string)) + (if string + (fillarray string 0)))))) (defun epg-status-GOODSIG (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result + (epg-context-set-result-for epg-context 'verify (cons (epg-make-signature 'good (match-string 1 string) (match-string 2 string)) - (epg-context-result epg-context 'verify))))) + (epg-context-result-for epg-context 'verify))))) (defun epg-status-EXPSIG (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result + (epg-context-set-result-for epg-context 'verify (cons (epg-make-signature 'expired (match-string 1 string) (match-string 2 string)) - (epg-context-result epg-context 'verify))))) + (epg-context-result-for epg-context 'verify))))) (defun epg-status-EXPKEYSIG (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result + (epg-context-set-result-for epg-context 'verify (cons (epg-make-signature 'expired-key (match-string 1 string) (match-string 2 string)) - (epg-context-result epg-context 'verify))))) + (epg-context-result-for epg-context 'verify))))) (defun epg-status-REVKEYSIG (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result + (epg-context-set-result-for epg-context 'verify (cons (epg-make-signature 'revoked-key (match-string 1 string) (match-string 2 string)) - (epg-context-result epg-context 'verify))))) + (epg-context-result-for epg-context 'verify))))) (defun epg-status-BADSIG (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) - (epg-context-set-result + (epg-context-set-result-for epg-context 'verify (cons (epg-make-signature 'bad (match-string 1 string) (match-string 2 string)) - (epg-context-result epg-context 'verify))))) + (epg-context-result-for epg-context 'verify))))) (defun epg-status-TRUST_UNDEFINED (process string) - (let ((signature (car (epg-context-result epg-context 'verify)))) + (let ((signature (car (epg-context-result-for epg-context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) (epg-signature-set-validity signature 'unknown)))) (defun epg-status-TRUST_NEVER (process string) - (let ((signature (car (epg-context-result epg-context 'verify)))) + (let ((signature (car (epg-context-result-for epg-context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) (epg-signature-set-validity signature 'never)))) (defun epg-status-TRUST_MARGINAL (process string) - (let ((signature (car (epg-context-result epg-context 'verify)))) + (let ((signature (car (epg-context-result-for epg-context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'marginal)) (epg-signature-set-validity signature 'marginal)))) (defun epg-status-TRUST_FULLY (process string) - (let ((signature (car (epg-context-result epg-context 'verify)))) + (let ((signature (car (epg-context-result-for epg-context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) (epg-signature-set-validity signature 'full)))) (defun epg-status-TRUST_ULTIMATE (process string) - (let ((signature (car (epg-context-result epg-context 'verify)))) + (let ((signature (car (epg-context-result-for epg-context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) (epg-signature-set-validity signature 'full)))) -(defun epg-status-DECRYPTION_FAILED (process string) - (epg-context-set-result epg-context 'decrypt 'failed)) - (defun epg-status-PROGRESS (process string) (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)" string) - (funcall (car (epg-context-progress-callback epg-context)) + (funcall (car (epg-context-progress-callback-info epg-context)) (match-string 1 string) (match-string 2 string) (string-to-number (match-string 3 string)) - (string-to-number (match-string 4 string))))) + (string-to-number (match-string 4 string)) + (cdr (epg-context-progress-callback-info epg-context))))) -(defun epg-passphrase-callback (key-id handback) +(defun epg-status-DECRYPTION_FAILED (process string) + (epg-context-set-result-for + epg-context 'error + (cons 'decryption-failed + (epg-context-result-for epg-context 'error)))) + +(defun epg-status-NODATA (process string) + (epg-context-set-result-for + epg-context 'error + (cons (cons 'no-data (string-to-number string)) + (epg-context-result-for epg-context 'error)))) + +(defun epg-status-UNEXPECTED (process string) + (epg-context-set-result-for + epg-context 'error + (cons (cons 'unexpected (string-to-number string)) + (epg-context-result-for epg-context 'error)))) + +(defun epg-status-KEYEXPIRED (process string) + (epg-context-set-result-for + epg-context 'error + (cons (cons 'key-expired string) + (epg-context-result-for epg-context 'error)))) + +(defun epg-status-KEYREVOKED (process string) + (epg-context-set-result-for + epg-context 'error + (cons 'key-revoked + (epg-context-result-for epg-context 'error)))) + +(defun epg-status-BADARMOR (process string) + (epg-context-set-result-for + epg-context 'error + (cons 'bad-armor + (epg-context-result-for epg-context 'error)))) + +(defun epg-passphrase-callback-function (key-id handback) (read-passwd (if (eq key-id 'SYM) - "GnuPG passphrase for symmetric encryption: " + "Passphrase for symmetric encryption: " (if (eq key-id 'PIN) - "GnuPG passphrase for PIN: " - (format "GnuPG passphrase for %s: " + "Passphrase for PIN: " + (format "Passphrase for %s: " (let ((entry (assoc key-id epg-user-id-alist))) (if entry (cdr entry) key-id))))))) -(defun epg-progress-callback (what char current total handback) +(defun epg-progress-callback-function (what char current total handback) (message "%s: %d%%/%d%%" what current total)) (defun epg-list-keys (name &optional secret) @@ -476,33 +523,105 @@ This function is for internal use only." (setq alist (cdr alist))) (nreverse result))) +(if (fboundp 'make-temp-file) + (defalias 'epg-make-temp-file 'make-temp-file) + ;; stolen from poe.el. + (defun epg-make-temp-file (prefix) + "Create a temporary file. +The returned file name (created by appending some random characters at the end +of PREFIX, and expanding against `temporary-file-directory' if necessary), +is guaranteed to point to a newly created empty file. +You can then use `write-region' to write new data into the file." + (let (tempdir tempfile) + (unwind-protect + (let (file) + ;; First, create a temporary directory. + (while (condition-case () + (progn + (setq tempdir (make-temp-name + (concat + (file-name-directory prefix) + "DIR"))) + ;; return nil or signal an error. + (make-directory tempdir)) + ;; let's try again. + (file-already-exists t))) + (set-file-modes tempdir 448) + ;; Second, create a temporary file in the tempdir. + ;; There *is* a race condition between `make-temp-name' + ;; and `write-region', but we don't care it since we are + ;; in a private directory now. + (setq tempfile (make-temp-name (concat tempdir "/EMU"))) + (write-region "" nil tempfile nil 'silent) + (set-file-modes tempfile 384) + ;; Finally, make a hard-link from the tempfile. + (while (condition-case () + (progn + (setq file (make-temp-name prefix)) + ;; return nil or signal an error. + (add-name-to-file tempfile file)) + ;; let's try again. + (file-already-exists t))) + file) + ;; Cleanup the tempfile. + (and tempfile + (file-exists-p tempfile) + (delete-file tempfile)) + ;; Cleanup the tempdir. + (and tempdir + (file-directory-p tempdir) + (delete-directory tempdir)))))) + ;;;###autoload (defun epg-decrypt-start (context input-file) - "Initiate a decrypt operation." + "Initiate a decrypt operation on INPUT-FILE. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-decrypt-string' instead." (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start context (list "--decrypt" input-file)) (epg-wait-for-status context '("BEGIN_DECRYPTION"))) ;;;###autoload +(defun epg-decrypt-file (context input-file) + "Decrypt INPUT-FILE and return the plain text." + (unwind-protect + (progn + (epg-decrypt-start context input-file) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Decryption failed")) + (epg-read-output context)) + (epg-reset context))) + +;;;###autoload (defun epg-decrypt-string (context string) - "Decrypt STRING." + "Decrypt STRING and return the plain text." (let ((input-file (epg-make-temp-file "epg-input")) (coding-system-for-write 'binary)) (unwind-protect (progn (write-region string nil input-file) - (epg-decrypt-start context input-file) - (epg-wait-for-completion context) - (unless (epg-context-result context 'decrypt) - (epg-read-output context))) - (epg-reset context) + (epg-decrypt-file context input-file)) (if (file-exists-p input-file) (delete-file input-file))))) ;;;###autoload (defun epg-verify-start (context signature &optional string) - "Initiate a verify operation." + "Initiate a verify operation on SIGNATURE. + +For a detached signature, both SIGNATURE and STRING should be string. +For a normal or a clear text signature, STRING should be nil. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-verify-string' instead." (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (if string ;; Detached signature. @@ -513,14 +632,16 @@ This function is for internal use only." (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) string))) ;; Normal (or cleartext) signature. - (epg-start context - (list "--verify")) + (epg-start context (list "--verify")) (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) signature)))) ;;;###autoload (defun epg-verify-string (context signature &optional string) - "Verify SIGNATURE." + "Verify SIGNATURE. + +For a detached signature, both SIGNATURE and STRING should be string. +For a normal or a clear text signature, STRING should be nil." (let ((input-file (epg-make-temp-file "epg-input")) (coding-system-for-write 'binary)) (unwind-protect @@ -529,21 +650,31 @@ This function is for internal use only." (write-region signature nil input-file)) (epg-verify-start context input-file string) (epg-wait-for-completion context) - (epg-context-result context 'verify)) + (epg-context-result-for context 'verify)) (epg-reset context) (if (file-exists-p input-file) (delete-file input-file))))) ;;;###autoload (defun epg-sign-start (context string &optional mode) - "Initiate a sign operation." + "Initiate a sign operation on STRING. + +If optional 3rd argument MODE is 'clearsign, it makes a clear text signature. +If MODE is t or 'detached, it makes a detached signature. +Otherwise, it makes a normal signature. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-sign-string' instead." (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start context - (append (list (if (null mode) - "--sign" + (append (list (if (eq mode 'clearsign) + "--clearsign" (if (or (eq mode t) (eq mode 'detached)) "--detach-sign" - "--clearsign"))) + "--sign"))) (apply #'nconc (mapcar (lambda (signer) (list "-u" signer)) @@ -554,18 +685,30 @@ This function is for internal use only." ;;;###autoload (defun epg-sign-string (context string &optional mode) - "Sign STRING." + "Sign STRING and return the output as string. +If optional 3rd argument MODE is 'clearsign, it makes a clear text signature. +If MODE is t or 'detached, it makes a detached signature. +Otherwise, it makes a normal signature." (unwind-protect (progn (epg-sign-start context string mode) (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Sign failed")) (epg-read-output context)) (epg-reset context))) ;;;###autoload (defun epg-encrypt-start (context string recipients - &optional always-trust sign) - "Initiate a encrypt operation." + &optional sign always-trust) + "Initiate a encrypt operation on STRING. +If RECIPIENTS is nil, it performs symmetric encryption. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporaly output file. +If you are unsure, use synchronous version of this function +`epg-encrypt-string' instead." (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start context (append (if always-trust '("--always-trust")) @@ -581,18 +724,23 @@ This function is for internal use only." (list "-r" recipient)) recipients)))) (if sign - (epg-wait-for-status context '("BEGIN_SIGNING"))) + (epg-wait-for-status context '("BEGIN_SIGNING")) + (if (null recipients) + (epg-wait-for-status context '("BEGIN_ENCRYPTION")))) (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) string))) ;;;###autoload (defun epg-encrypt-string (context string recipients - &optional always-trust sign) - "Encrypt STRING." + &optional sign always-trust) + "Encrypt STRING. +If RECIPIENTS is nil, it performs symmetric encryption." (unwind-protect (progn - (epg-encrypt-start context string recipients always-trust sign) + (epg-encrypt-start context string recipients sign always-trust) (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Encrypt failed")) (epg-read-output context)) (epg-reset context)))