X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=e3ff7cda11ca2dd6a7304e99a9cafc8704d33204;hb=372371d54ef4c1060f3cfc70e557b28f4a4f8ee1;hp=bcc09d0a51d8ce03d8a184207f5b58743972b1e2;hpb=b519d270bfd757ae87986e9eb0fe804f2e1e8eff;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index bcc09d0..e3ff7cd 100644 --- a/epg.el +++ b/epg.el @@ -1,4 +1,4 @@ -;;; epg.el --- EasyPG, yet another GnuPG interface. +;;; epg.el --- the EasyPG Library ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, ;; 2005, 2006 Free Software Foundation, Inc. ;; Copyright (C) 2006 Daiki Ueno @@ -26,7 +26,7 @@ ;;; Code: (defgroup epg () - "EasyPG, yet another GnuPG interface.") + "The EasyPG Library") (defcustom epg-gpg-program "gpg" "The `gpg' executable." @@ -45,46 +45,7 @@ (defvar epg-context nil) (defvar epg-debug nil) -(defvar epg-colons-pub-spec - '((trust "[^:]") - (length "[0-9]+" 0 string-to-number) - (algorithm "[0-9]+" 0 string-to-number) - (key-id "[^:]+") - (creation-date "[0-9]+") - (expiration-date "[0-9]+") - nil - (ownertrust "[^:]") - nil - nil - (capability "[escaESCA]*")) - "The schema of keylisting output whose type is \"pub\". -This is used by `epg-list-keys'.") - -(defvar epg-colons-sec-spec - '((trust "[^:]") - (length "[0-9]+" 0 string-to-number) - (algorithm "[0-9]+" 0 string-to-number) - (key-id "[^:]+") - (creation-date "[0-9]+") - (expiration-date "[0-9]+") - nil - (ownertrust "[^:]")) -"The schema of keylisting output whose type is \"sec\". -This is used by `epg-list-keys'.") - -(defvar epg-colons-uid-spec - '((trust "[^:]") - nil - nil - nil - (creation-date "[0-9]+") - (expiration-date "[0-9]+") - (hash "[^:]+") - nil - (user-id "[^:]+")) - "The schema of keylisting output whose type is \"uid\". -This is used by `epg-list-keys'.") - +;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist '((0 . "NONE") (1 . "IDEA") @@ -97,6 +58,7 @@ This is used by `epg-list-keys'.") (10 . "TWOFISH") (110 . "DUMMY"))) +;; from gnupg/include/cipher.h (defconst epg-pubkey-algorithm-alist '((1 . "RSA") (2 . "RSA_E") @@ -105,6 +67,7 @@ This is used by `epg-list-keys'.") (17 . "DSA") (20 . "ELGAMAL"))) +;; from gnupg/include/cipher.h (defconst epg-digest-algorithm-alist '((1 . "MD5") (2 . "SHA1") @@ -113,12 +76,45 @@ This is used by `epg-list-keys'.") (9 . "SHA384") (10 . "SHA512"))) +;; from gnupg/include/cipher.h (defconst epg-compress-algorithm-alist '((0 . "NONE") (1 . "ZIP") (2 . "ZLIB") (3 . "BZIP2"))) +(defconst epg-invalid-recipients-alist + '((0 . "No specific reason given") + (1 . "Not Found") + (2 . "Ambigious specification") + (3 . "Wrong key usage") + (4 . "Key revoked") + (5 . "Key expired") + (6 . "No CRL known") + (7 . "CRL too old") + (8 . "Policy mismatch") + (9 . "Not a secret key") + (10 . "Key not trusted"))) + +(defvar epg-key-validity-alist + '((?o . unknown) + (?i . invalid) + (?d . disabled) + (?r . revoked) + (?e . expired) + (?- . none) + (?q . undefined) + (?n . never) + (?m . marginal) + (?f . full) + (?u . ultimate))) + +(defvar epg-key-capablity-alist + '((?e . encrypt) + (?s . sign) + (?c . certify) + (?a . authentication))) + (defvar epg-prompt-alist nil) (defun epg-make-data-from-file (file) @@ -274,6 +270,97 @@ This function is for internal use only." "Set the fingerprint of SIGNATURE." (aset signature 4 fingerprint)) +(defun epg-make-key (owner-trust) + "Return a key object." + (vector owner-trust nil nil)) + +(defun epg-key-owner-trust (key) + "Return the owner trust of KEY." + (aref key 0)) + +(defun epg-key-sub-key-list (key) + "Return the sub key list of KEY." + (aref key 1)) + +(defun epg-key-user-id-list (key) + "Return the user ID list of KEY." + (aref key 2)) + +(defun epg-key-set-sub-key-list (key sub-key-list) + "Set the sub key list of KEY." + (aset key 1 sub-key-list)) + +(defun epg-key-set-user-id-list (key user-id-list) + "Set the user ID list of KEY." + (aset key 2 user-id-list)) + +(defun epg-make-sub-key (validity capability secret algorithm length id + creation-time expiration-time) + "Return a sub key object." + (vector validity capability secret algorithm length id creation-time + expiration-time nil)) + +(defun epg-sub-key-validity (sub-key) + "Return the validity of SUB-KEY." + (aref sub-key 0)) + +(defun epg-sub-key-capability (sub-key) + "Return the capability of SUB-KEY." + (aref sub-key 1)) + +(defun epg-sub-key-secret (sub-key) + "Return non-nil if SUB-KEY is a secret key." + (aref sub-key 2)) + +(defun epg-sub-key-algorithm (sub-key) + "Return the algorithm of SUB-KEY." + (aref sub-key 3)) + +(defun epg-sub-key-length (sub-key) + "Return the length of SUB-KEY." + (aref sub-key 4)) + +(defun epg-sub-key-id (sub-key) + "Return the ID of SUB-KEY." + (aref sub-key 5)) + +(defun epg-sub-key-creation-time (sub-key) + "Return the creation time of SUB-KEY." + (aref sub-key 6)) + +(defun epg-sub-key-expiration-time (sub-key) + "Return the expiration time of SUB-KEY." + (aref sub-key 7)) + +(defun epg-sub-key-fingerprint (sub-key) + "Return the fingerprint of SUB-KEY." + (aref sub-key 8)) + +(defun epg-sub-key-set-fingerprint (sub-key fingerprint) + "Set the fingerprint of SUB-KEY. +This function is for internal use only." + (aset sub-key 8 fingerprint)) + +(defun epg-make-user-id (validity name) + "Return a user ID object." + (vector validity name nil)) + +(defun epg-user-id-validity (user-id) + "Return the validity of USER-ID." + (aref user-id 0)) + +(defun epg-user-id-name (user-id) + "Return the name of USER-ID." + (aref user-id 1)) + +(defun epg-user-id-signature-list (user-id) + "Return the signature list of USER-ID." + (aref user-id 2)) + +(defun epg-user-id-set-signature-list (user-id signature-list) + "Set the signature list of USER-ID." + (aset user-id 2 signature-list)) + (defun epg-context-result-for (context name) (cdr (assq name (epg-context-result context)))) @@ -288,7 +375,8 @@ This function is for internal use only." "Start `epg-gpg-program' in a subprocess with given ARGS." (let* ((args (append (list "--no-tty" "--status-fd" "1" - "--command-fd" "0") + "--command-fd" "0" + "--yes") (if (epg-context-armor context) '("--armor")) (if (epg-context-textmode context) '("--textmode")) (if (epg-context-output-file context) @@ -510,7 +598,7 @@ 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 'fully)))) + (epg-signature-set-validity signature 'full)))) (defun epg-status-TRUST_ULTIMATE (process string) (let ((signature (car (epg-context-result-for epg-context 'verify)))) @@ -567,6 +655,21 @@ This function is for internal use only." (cons 'bad-armor (epg-context-result-for epg-context 'error)))) +(defun epg-status-INV_RECP (process string) + (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string) + (epg-context-set-result-for + epg-context 'error + (cons (list 'invalid-recipient + (string-to-number (match-string 1 string)) + (match-string 2 string)) + (epg-context-result-for epg-context 'error))))) + +(defun epg-status-NO_RECP (process string) + (epg-context-set-result-for + epg-context 'error + (cons 'no-recipients + (epg-context-result-for epg-context 'error)))) + (defun epg-passphrase-callback-function (key-id handback) (read-passwd (if (eq key-id 'SYM) @@ -601,59 +704,81 @@ This function is for internal use only." config)))) config)) -(defun epg-list-keys (name &optional secret) - "List keys associated with STRING." +(defun epg-list-keys-1 (name mode) (let ((args (append (list "--with-colons" "--no-greeting" "--batch" - "--fixed-list-mode" - (if secret "--list-secret-keys" "--list-keys")) + "--fixed-list-mode" "--with-fingerprint" + "--with-fingerprint" + (if mode "--list-secret-keys" "--list-keys")) (if name (list name)))) - keys type symbol pointer) + keys string field index) (with-temp-buffer (apply #'call-process epg-gpg-program nil (list t nil) nil args) (goto-char (point-min)) - (while (re-search-forward "^\\([a-z][a-z][a-z]\\):\\(.*\\)" nil t) - (setq type (match-string 1) - symbol (intern-soft (format "epg-colons-%s-spec" type))) - (if (member type '("pub" "sec")) - (setq keys (cons nil keys))) - (if (and symbol - (boundp symbol)) - (setcar keys (cons (cons (intern type) - (epg-parse-colons - (symbol-value symbol) - (match-string 2))) - (car keys)))) - (forward-line))) - (setq pointer keys) - (while pointer - (setcar pointer (nreverse (car pointer))) - (setq pointer (cdr pointer))) + (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t) + (setq keys (cons (make-vector 15 nil) keys) + string (match-string 0) + index 0 + field 0) + (while (eq index + (string-match "\\([^:]+\\)?:" string index)) + (setq index (match-end 0)) + (aset (car keys) field (match-string 1 string)) + (setq field (1+ field)))) + (nreverse keys)))) + +(defun epg-make-sub-key-1 (line) + (epg-make-sub-key + (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)) + (delq nil + (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist))) + (aref line 11))) + (member (aref line 0) '("sec" "ssb")) + (string-to-number (aref line 3)) + (string-to-number (aref line 2)) + (aref line 4) + (aref line 5) + (aref line 6))) + +(defun epg-list-keys (&optional name mode) + (let ((lines (epg-list-keys-1 name mode)) + keys) + (while lines + (cond + ((member (aref (car lines) 0) '("pub" "sec")) + (when (car keys) + (epg-key-set-sub-key-list + (car keys) + (nreverse (epg-key-sub-key-list (car keys)))) + (epg-key-set-user-id-list + (car keys) + (nreverse (epg-key-user-id-list (car keys))))) + (setq keys (cons (epg-make-key + (cdr (assq (string-to-char (aref (car lines) 8)) + epg-key-validity-alist))) + keys)) + (epg-key-set-sub-key-list + (car keys) + (cons (epg-make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys))))) + ((member (aref (car lines) 0) '("sub" "ssb")) + (epg-key-set-sub-key-list + (car keys) + (cons (epg-make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys))))) + ((equal (aref (car lines) 0) "uid") + (epg-key-set-user-id-list + (car keys) + (cons (epg-make-user-id + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist)) + (aref (car lines) 9)) + (epg-key-user-id-list (car keys))))) + ((equal (aref (car lines) 0) "fpr") + (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys))) + (aref (car lines) 9)))) + (setq lines (cdr lines))) (nreverse keys))) -(defun epg-parse-colons (alist string) - (let ((index 0) - result) - (while (and alist - (or (null (car alist)) - (eq index - (string-match - (concat "\\(" (nth 1 (car alist)) "\\)?:") - string index)))) - (if (car alist) - (progn - (setq index (match-end 0)) - (if (match-beginning 1) - (setq result - (cons (cons (car (car alist)) - (funcall (or (nth 3 (car alist)) #'identity) - (match-string - (1+ (or (nth 2 (car alist)) 0)) - string))) - result)))) - (setq index (1+ index))) - (setq alist (cdr alist))) - (nreverse result))) - (if (fboundp 'make-temp-file) (defalias 'epg-make-temp-file 'make-temp-file) ;; stolen from poe.el. @@ -732,7 +857,8 @@ If PLAIN is nil, it returns the result as a string." (epg-start-decrypt context (epg-make-data-from-file cipher)) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) - (error "Decryption failed")) + (error "Decrypt failed: %S" + (epg-context-result-for context 'error))) (unless plain (epg-read-output context))) (unless plain @@ -752,7 +878,8 @@ If PLAIN is nil, it returns the result as a string." (epg-start-decrypt context (epg-make-data-from-file input-file)) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) - (error "Decryption failed")) + (error "Decrypt failed: %S" + (epg-context-result-for context 'error))) (epg-read-output context)) (epg-delete-output-file context) (if (file-exists-p input-file) @@ -894,7 +1021,8 @@ Otherwise, it makes a normal signature." (epg-start-sign context (epg-make-data-from-file plain) mode) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) - (error "Sign failed")) + (error "Sign failed: %S" + (epg-context-result-for context 'error))) (unless signature (epg-read-output context))) (unless signature @@ -914,7 +1042,8 @@ Otherwise, it makes a normal signature." (epg-start-sign context (epg-make-data-from-string plain) mode) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) - (error "Sign failed")) + (error "Sign failed: %S" + (epg-context-result-for context 'error))) (epg-read-output context)) (epg-delete-output-file context) (epg-reset context))) @@ -972,7 +1101,8 @@ If RECIPIENTS is nil, it performs symmetric encryption." recipients sign always-trust) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) - (error "Encrypt failed")) + (error "Encrypt failed: %S" + (epg-context-result-for context 'error))) (unless cipher (epg-read-output context))) (unless cipher @@ -992,7 +1122,8 @@ If RECIPIENTS is nil, it performs symmetric encryption." recipients sign always-trust) (epg-wait-for-completion context) (if (epg-context-result-for context 'error) - (error "Encrypt failed")) + (error "Encrypt failed: %S" + (epg-context-result-for context 'error))) (epg-read-output context)) (epg-delete-output-file context) (epg-reset context)))