X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=de72571a6423696f10a5b6b2fd10cb132bc0411c;hb=95ff40c9179c88308fe96e1adb0ef220b67f265c;hp=cd5ecb63b02f62507d1e2f7906da7e5a884ecc05;hpb=b4b57c9f5289d2699225fa15fdf8074e22622c0b;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index cd5ecb6..de72571 100644 --- a/epg.el +++ b/epg.el @@ -1,3 +1,30 @@ +;;; epg.el --- EasyPG, yet another GnuPG interface. +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2006 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: PGP, GnuPG + +;; This file is part of EasyPG. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Code: + (defgroup epg () "EasyPG, yet another GnuPG interface.") @@ -57,6 +84,8 @@ This is used by `epg-list-keys'.") (user-id "[^:]+")) "The schema of keylisting output whose type is \"uid\". This is used by `epg-list-keys'.") + +(defvar epg-prompt-alist nil) (defun epg-make-context (&optional protocol armor textmode include-certs) "Return a context object." @@ -153,7 +182,7 @@ This function is for internal use only." (defun epg-make-signature (status key-id user-id) "Return a signature object." - (vector status key-id user-id nil)) + (vector status key-id user-id nil nil)) (defun epg-signature-status (signature) "Return the status code of SIGNATURE." @@ -171,6 +200,10 @@ This function is for internal use only." "Return the validity of SIGNATURE." (aref signature 3)) +(defun epg-signature-fingerprint (signature) + "Return the fingerprint of SIGNATURE." + (aref signature 4)) + (defun epg-signature-set-status (signature status) "Set the status code of SIGNATURE." (aset signature 0 status)) @@ -187,6 +220,10 @@ This function is for internal use only." "Set the validity of SIGNATURE." (aset signature 3 validity)) +(defun epg-signature-set-fingerprint (signature fingerprint) + "Set the fingerprint of SIGNATURE." + (aset signature 4 fingerprint)) + (defun epg-context-result-for (context name) (cdr (assq name (epg-context-result context)))) @@ -260,7 +297,8 @@ 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-textmode context) 'raw-text @@ -276,7 +314,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. @@ -288,8 +327,7 @@ This function is for internal use only." (kill-buffer (process-buffer (epg-context-process context)))) (epg-context-set-process context nil) (if (file-exists-p (epg-context-output-file context)) - (delete-file (epg-context-output-file context))) - (aset context 9 nil)) + (delete-file (epg-context-output-file context)))) (defun epg-status-USERID_HINT (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) @@ -327,6 +365,17 @@ This function is for internal use only." (if string (fillarray string 0)))))) +(defun epg-status-GET_BOOL (process string) + (let ((entry (assoc string epg-prompt-alist))) + (if (y-or-n-p (if entry (cdr entry) (concat string "? "))) + (process-send-string process "y\n") + (process-send-string process "n\n")))) + +(defun epg-status-GET_LINE (process string) + (let* ((entry (assoc string epg-prompt-alist)) + (string (read-string (if entry (cdr entry) (concat string ": "))))) + (process-send-string process (concat string "\n"))))) + (defun epg-status-GOODSIG (process string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) (epg-context-set-result-for @@ -377,11 +426,18 @@ This function is for internal use only." (match-string 2 string)) (epg-context-result-for epg-context 'verify))))) +(defun epg-status-VALIDSIG (process string) + (let ((signature (car (epg-context-result-for epg-context 'verify)))) + (if (and signature + (eq (epg-signature-status signature) 'good) + (string-match "\\`\\([^ ]+\\) " string)) + (epg-signature-set-fingerprint signature (match-string 1 string))))) + (defun epg-status-TRUST_UNDEFINED (process string) - (let ((signature (car (epg-context-result-for-for 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)))) + (epg-signature-set-validity signature 'undefined)))) (defun epg-status-TRUST_NEVER (process string) (let ((signature (car (epg-context-result-for epg-context 'verify)))) @@ -399,16 +455,13 @@ This function is for internal use only." (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)))) + (epg-signature-set-validity signature 'fully)))) (defun epg-status-TRUST_ULTIMATE (process string) (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-for epg-context 'decrypt 'failed)) + (epg-signature-set-validity signature 'ultimate)))) (defun epg-status-PROGRESS (process string) (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)" @@ -420,17 +473,52 @@ This function is for internal use only." (string-to-number (match-string 4 string)) (cdr (epg-context-progress-callback-info epg-context))))) +(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) "Passphrase for symmetric encryption: " (if (eq key-id 'PIN) "Passphrase for PIN: " - (format "Passphrase for %s: " - (let ((entry (assoc key-id epg-user-id-alist))) - (if entry - (cdr entry) - key-id))))))) + (let ((entry (assoc key-id epg-user-id-alist))) + (if entry + (format "Passphrase for %s %s: " key-id (cdr entry)) + (format "Passphrase for %s: " key-id))))))) (defun epg-progress-callback-function (what char current total handback) (message "%s: %d%%/%d%%" what current total)) @@ -488,10 +576,57 @@ This function is for internal use only." (setq alist (cdr alist))) (nreverse result))) -(defalias 'epg-make-temp-file 'make-temp-file) +(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) +(defun epg-start-decrypt (context input-file) "Initiate a decrypt operation on INPUT-FILE. If you use this function, you will need to wait for the completion of @@ -499,6 +634,7 @@ If you use this function, you will need to wait for the completion of `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-result context nil) (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start context (list "--decrypt" input-file)) @@ -509,13 +645,12 @@ If you are unsure, use synchronous version of this function "Decrypt INPUT-FILE and return the plain text." (unwind-protect (progn - (epg-decrypt-start context input-file) + (epg-start-decrypt context input-file) (epg-wait-for-completion context) - (unless (epg-context-result-for context 'decrypt) - (epg-read-output context))) - (epg-reset context) - (if (file-exists-p input-file) - (delete-file input-file)))) + (if (epg-context-result-for context 'error) + (error "Decryption failed")) + (epg-read-output context)) + (epg-reset context))) ;;;###autoload (defun epg-decrypt-string (context string) @@ -530,7 +665,7 @@ If you are unsure, use synchronous version of this function (delete-file input-file))))) ;;;###autoload -(defun epg-verify-start (context signature &optional string) +(defun epg-start-verify (context signature &optional string) "Initiate a verify operation on SIGNATURE. For a detached signature, both SIGNATURE and STRING should be string. @@ -541,6 +676,7 @@ If you use this function, you will need to wait for the completion of `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-result context nil) (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (if string ;; Detached signature. @@ -556,6 +692,19 @@ If you are unsure, use synchronous version of this function (process-send-string (epg-context-process context) signature)))) ;;;###autoload +(defun epg-verify-file (context input-file &optional string) + "Verify INPUT-FILE. + +For a detached signature, both INPUT-FILE and STRING should be string. +For a normal or a clear text signature, STRING should be nil." + (unwind-protect + (progn + (epg-start-verify context input-file string) + (epg-wait-for-completion context) + (epg-context-result-for context 'verify)) + (epg-reset context))) + +;;;###autoload (defun epg-verify-string (context signature &optional string) "Verify SIGNATURE. @@ -567,15 +716,12 @@ For a normal or a clear text signature, STRING should be nil." (progn (if string (write-region signature nil input-file)) - (epg-verify-start context input-file string) - (epg-wait-for-completion context) - (epg-context-result-for context 'verify)) - (epg-reset context) + (epg-verify-file context input-file string)) (if (file-exists-p input-file) (delete-file input-file))))) ;;;###autoload -(defun epg-sign-start (context string &optional mode) +(defun epg-start-sign (context string &optional mode) "Initiate a sign operation on STRING. If optional 3rd argument MODE is 'clearsign, it makes a clear text signature. @@ -587,9 +733,10 @@ If you use this function, you will need to wait for the completion of `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-result context nil) (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start context - (append (list (if (eq 'clearsign) + (append (list (if (eq mode 'clearsign) "--clearsign" (if (or (eq mode t) (eq mode 'detached)) "--detach-sign" @@ -610,15 +757,17 @@ 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-start-sign 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 +(defun epg-start-encrypt (context string recipients &optional sign always-trust) - "Initiate a encrypt operation on STRING. + "Initiate an 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 @@ -626,6 +775,7 @@ If you use this function, you will need to wait for the completion of `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-result context nil) (epg-context-set-output-file context (epg-make-temp-file "epg-output")) (epg-start context (append (if always-trust '("--always-trust")) @@ -654,8 +804,62 @@ If you are unsure, use synchronous version of this function If RECIPIENTS is nil, it performs symmetric encryption." (unwind-protect (progn - (epg-encrypt-start context string recipients sign always-trust) + (epg-start-encrypt 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))) + +;;;###autoload +(defun epg-start-export-keys (context pattern) + "Initiate an export keys operation. + +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-export-keys' instead." + (epg-context-set-result context nil) + (epg-context-set-output-file context (epg-make-temp-file "epg-output")) + (epg-start context (list "--export" pattern))) + +;;;###autoload +(defun epg-export-keys (context pattern) + "Extract public keys matched with PATTERN and return them." + (unwind-protect + (progn + (epg-start-export-keys context pattern) + (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Export keys failed")) + (epg-read-output context)) + (epg-reset context))) + +;;;###autoload +(defun epg-start-import-keys (context keys) + "Initiate an import key operation. + +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-import-keys' instead." + (epg-context-set-result context nil) + (epg-context-set-output-file context (epg-make-temp-file "epg-output")) + (epg-start context (list "--import")) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) keys))) + +;;;###autoload +(defun epg-import-keys (context keys) + "Add KEYS." + (unwind-protect + (progn + (epg-start-import-keys context keys) (epg-wait-for-completion context) + (if (epg-context-result-for context 'error) + (error "Import keys failed")) (epg-read-output context)) (epg-reset context)))