X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=6356fae90ef7ba09fcb2b3e2b4391067df8dd04f;hb=2e94c33259041a3d708a3dc267371a5ef29d3ad0;hp=a775f54f3fd620d1a568833729445d0676c870f8;hpb=564ad4ae9acdf84d2148c196bbbc9ac5b06586f5;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index a775f54..6356fae 100644 --- a/epg.el +++ b/epg.el @@ -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,32 @@ 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"))) +(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 +257,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,8 +362,7 @@ 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" - "--yes") ; overwrite + "--command-fd" "0") (if (epg-context-armor context) '("--armor")) (if (epg-context-textmode context) '("--textmode")) (if (epg-context-output-file context) @@ -511,7 +584,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)))) @@ -584,7 +657,7 @@ This function is for internal use only." (defun epg-configuration () "Return a list of internal configuration parameters of `epg-gpg-program'." - (let (configuration type) + (let (config type) (with-temp-buffer (apply #'call-process epg-gpg-program nil (list t nil) nil '("--with-colons" "--list-config")) @@ -602,59 +675,81 @@ This function is for internal use only." config)))) config)) -(defun epg-list-keys (name &optional secret) - "List keys associated with STRING." - (let ((args (list "--with-colons" "--no-greeting" "--batch" - "--fixed-list-mode" - (if secret "--list-secret-keys" "--list-keys") - name)) - keys type symbol pointer) +(defun epg-list-keys-1 (name mode) + (let ((args (append (list "--with-colons" "--no-greeting" "--batch" + "--fixed-list-mode" "--with-fingerprint" + "--with-fingerprint" + (if mode "--list-secret-keys" "--list-keys")) + (if name (list name)))) + 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.