From: ueno Date: Wed, 23 Feb 2000 14:17:52 +0000 (+0000) Subject: Sync up with EMIKO 1.13.11. X-Git-Tag: remi-1_14_1~9 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b93c121170b21448b3cd5c144dd5ec62dd04996e;p=elisp%2Fsemi.git Sync up with EMIKO 1.13.11. --- diff --git a/ChangeLog b/ChangeLog index 415efb2..e45bf02 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2000-02-23 Daiki Ueno + + * mime-image.el + (mime-image-normalize-xbm-buffer): New inline function. + (mime-image-create) [XEmacs || Emacs21]: Use it for XBM data. + (mime-display-image): Don't create temporary file. + 2000-02-22 MORIOKA Tomohiko * mime-view.el (mime-delq-null-situation): Accept multiple ignored @@ -30,6 +37,51 @@ * semi-setup.el: Use `eval-after-load' for text/html related setting. +2000-02-21 Daiki Ueno + + * semi-def.el (mime-user-interface-product): Bump up to + EMIKO 1.13.12. + + * pgg.el (pgg-temp-buffer-show-function): Use + `shrink-window-if-larger-than-buffer'. + + * pgg-gpg.el (pgg-gpg-process-region): Fix cleanup form. + + * pgg-pgp.el (pgg-pgp-process-region): Ditto. + + * pgg-pgp5.el (pgg-pgp5-process-region): Ditto. + + * semi-setup.el (mime-setup-enable-inline-image): Remove checking + of bitmap-mule; use `eval-after-load' instead of + `call-after-loaded' to require `mime-image'. + + * mime-image.el (mime-display-image): Set default umask to 077. + (mime-image-create): Use `nothing-image-instance-p'. + + * mime-pgp.el: When it is compiled, define `smime-output-buffer' + and `smime-errors-buffer' to avoid compiler warning. + + * mime-edit.el: Ditto. + + * mime-pgp.el + (mime-view-application/pkcs7-mime): Regard smime-type as + "enveloped-data" unless it is specified. + + * smime.el (smime-directory-files): Abolish. + (smime-verify-region): Abolish local variable `args'. + +2000-02-20 Daiki Ueno + + * mime-image.el: Remove X-Face setting; require cl when compiling. + (mime-image-format-alist): Remove image/x-mag and image/x-pic. + (mime-image-type-available-p): New function. + (mime-image-create): New function. + (mime-image-insert): New function. + (mime-display-image): Rewrite. + + * mime-edit.el + (mime-edit-define-charset): Handle 'mime-charset-comment. + 2000-02-18 MORIOKA Tomohiko * mime-view.el (mime-view-define-keymap): Change binding of @@ -98,6 +150,26 @@ * mime-view.el (mime-preview-follow-current-entity): Fix problem in multipart entity. +2000-02-07 Yoshiki Hayashi + + * mime-pgp.el: Fix doc string. + * pgg-def.el: Ditto. + * pgg-gpg.el: Ditto. + * pgg-parse.el: Ditto. + * pgg-pgp.el: Ditto. + * pgg-pgp5.el: Ditto. + * pgg.el: Ditto. + +2000-02-02 Nakagawa, Makoto + + * pgg-pgp5.el (pgg-scheme-verify-region): Copy the contents of + `pgg-errors-buffer' to `pgg-output-buffer'. + +2000-02-02 Daiki Ueno + + * pgg.el (pgg-temp-buffer-show-function): Don't check if the + selected window is the only window. + 2000-02-01 MORIOKA Tomohiko * semi-setup.el (mime-setup-enable-inline-image): Use "(fboundp diff --git a/EMIKO-VERSION b/EMIKO-VERSION deleted file mode 100644 index 280e4b8..0000000 --- a/EMIKO-VERSION +++ /dev/null @@ -1,21 +0,0 @@ -Euglena gracilis EMIKO 1.13.6 -Euglena caudata EMIKO 1.13.7 -Euglena oxyuris EMIKO 1.13.8 -Euglena tripteris EMIKO 1.13.9 -Euglena proxima EMIKO 1.13.10 -Euglena viridis -Euglena sociabilis -Euglena ehrenbergii -Euglena deses -Euglena pisciformis -Strombomonas acuminata -Lepocinclis salina -Lepocinclis wangi -Phacus longicauda -Phacus pleuronectes -Notosolenus -Anisonema -Petalomonas -Peranema -Urceolus -Entosiphon \ No newline at end of file diff --git a/mime-edit.el b/mime-edit.el index a8a38ff..bf2b552 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -128,6 +128,8 @@ "S/MIME encryption of current region.") (autoload 'smime-sign-region "smime" "S/MIME signature of current region.") +(defvar smime-output-buffer) +(defvar smime-errors-buffer) ;;; @ version @@ -524,7 +526,6 @@ If encoding is nil, it is determined from its contents." "A string formatted version of mime-transfer-level") (make-variable-buffer-local 'mime-transfer-level-string) - ;;; @@ about content transfer encoding (defvar mime-content-transfer-encoding-priority-list @@ -1400,7 +1401,11 @@ Optional argument ENCODING specifies an encoding method such as base64." (mime-create-tag (mime-edit-set-parameter (mime-edit-get-contype tag) - "charset" (upcase (symbol-name charset))) + "charset" + (let ((comment (get charset 'mime-charset-comment))) + (if comment + (concat (upcase (symbol-name charset)) " (" comment ")") + (upcase (symbol-name charset))))) (mime-edit-get-encoding tag))) )))) @@ -1759,6 +1764,8 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (replace-match (concat "-" (substring tag 2))) ))))) +(defvar mime-edit-pgp-user-id nil) + (defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction @@ -2509,8 +2516,6 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (defvar mime-edit-pgp-processing nil) (make-variable-buffer-local 'mime-edit-pgp-processing) -(defvar mime-edit-pgp-user-id nil) - (defun mime-edit-set-sign (arg) (interactive (list diff --git a/mime-image.el b/mime-image.el index ac3e957..588d228 100644 --- a/mime-image.el +++ b/mime-image.el @@ -36,118 +36,129 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (eval-when-compile (require 'static)) (require 'mime-view) (require 'alist) (require 'path-util) -(cond - ((featurep 'xemacs) - - (require 'images) - - (defun-maybe image-inline-p (format) - (or (memq format image-native-formats) - (find-if (function - (lambda (native) - (image-converter-chain format native))) - image-native-formats))) - - (image-register-netpbm-utilities) - (image-register-converter 'pic 'ppm "pictoppm") - (image-register-converter 'mag 'ppm "magtoppm") - - (defun image-insert-at-point (image) - (let ((e (make-extent (point) (point)))) - (set-extent-end-glyph e (make-glyph image)))) - - (defsubst-maybe image-invalid-glyph-p (glyph) - (or (null (aref glyph 0)) - (null (aref glyph 2)) - (equal (aref glyph 2) "")))) - ((featurep 'mule) - - (eval-when-compile (ignore-errors (require 'image))) - - (eval-and-compile - (autoload 'bitmap-insert-xbm-buffer "bitmap")) - - (static-if (fboundp 'image-type-available-p) - (defalias-maybe 'image-inline-p 'image-type-available-p) - (defvar image-native-formats '(xbm)) - (defun-maybe image-inline-p (format) - (memq format image-native-formats))) - - (static-unless (or (not (fboundp 'create-image)) - (memq 'data-p (aref (symbol-function 'create-image) 0))) - (defadvice create-image - (around data-p (file-or-data &optional type data-p &rest props) activate) - (if (ad-get-arg 2) - (setq ad-return-value - (nconc - (list 'image ':type (ad-get-arg 1) ':data (ad-get-arg 0)) - props)) - (ad-set-args 0 (list (ad-get-arg 0) (ad-get-arg 1) (ad-get-arg 3))) - ad-do-it))) - - (defun-maybe image-normalize (format data) - (if (memq format '(xbm xpm)) - (create-image data format 'data) - (let ((image-file - (make-temp-name - (expand-file-name "tm" temporary-file-directory)))) - (with-temp-buffer - (insert data) - (write-region-as-binary (point-min)(point-max) image-file)) - (create-image image-file format)))) - - (defun image-insert-at-point (image) - (static-if (fboundp 'insert-image) - (unwind-protect - (save-excursion - (static-if (condition-case nil - (progn (insert-image '(image)) nil) - (wrong-number-of-arguments t)) - (insert-image image "x") - (insert-image image)) - (insert "\n") - (save-window-excursion - (set-window-buffer (selected-window)(current-buffer)) - (sit-for 0))) - (let ((file (plist-get (cdr image) ':file))) - (and file (file-exists-p file) - (delete-file file)))) - (when (eq (plist-get (cdr image) ':type) 'xbm) - (save-restriction - (narrow-to-region (point)(point)) - (insert (plist-get (cdr image) ':data)) - (let ((mark (set-marker (make-marker) (point)))) - (bitmap-insert-xbm-buffer (current-buffer)) - (delete-region (point-min) mark)))))) - - (defsubst-maybe image-invalid-glyph-p (glyph) - (not (eq 'image (nth 0 glyph)))))) - -;; -;; X-Face -;; - -(cond - ((module-installed-p 'highlight-headers) - (eval-and-compile - (autoload 'highlight-headers "highlight-headers")) - - (defun mime-preview-x-face-function-use-highlight-headers () - (highlight-headers (point-min) (re-search-forward "^$" nil t) t)) - (add-hook 'mime-display-header-hook - 'mime-preview-x-face-function-use-highlight-headers)) - ((and (featurep 'mule) - (condition-case nil - (require 'x-face-mule) - (file-error nil)) - (exec-installed-p uncompface-program exec-path)) - (add-hook 'mime-display-header-hook 'x-face-decode-message-header))) +(defsubst mime-image-normalize-xbm-buffer (buffer) + (save-excursion + (set-buffer buffer) + (let ((case-fold-search t) width height xbytes right margin) + (goto-char (point-min)) + (or (re-search-forward "_width[\t ]+\\([0-9]+\\)" nil t) + (error "!! Illegal xbm file format" (current-buffer))) + (setq width (string-to-int (match-string 1)) + xbytes (/ (+ width 7) 8)) + (goto-char (point-min)) + (or (re-search-forward "_height[\t ]+\\([0-9]+\\)" nil t) + (error "!! Illegal xbm file format" (current-buffer))) + (setq height (string-to-int (match-string 1))) + (goto-char (point-min)) + (re-search-forward "0x[0-9a-f][0-9a-f],") + (delete-region (point-min) (match-beginning 0)) + (goto-char (point-min)) + (while (re-search-forward "[\n\r\t ,;}]" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "0x" nil t) + (replace-match "\\x" nil t)) + (goto-char (point-min)) + (insert "(" (number-to-string width) " " + (number-to-string height) " \"") + (goto-char (point-max)) + (insert "\")") + (goto-char (point-min)) + (read (current-buffer))))) + +(static-if (featurep 'xemacs) + (progn + (defun mime-image-type-available-p (type) + (memq type (image-instantiator-format-list))) + + (defun mime-image-create (file-or-data &optional type data-p &rest props) + (when (and data-p (eq type 'xbm)) + (with-temp-buffer + (insert file-or-data) + (setq file-or-data + (mime-image-normalize-xbm-buffer (current-buffer))))) + (let ((instance + (make-image-instance + (if (and type (mime-image-type-available-p type)) + (vconcat + (list type (if data-p :data :file) file-or-data) + props) + file-or-data) + nil nil 'noerror))) + (if (nothing-image-instance-p instance) nil + (make-glyph instance)))) + + (defun mime-image-insert (image string &optional area) + (let ((extent (make-extent (point) (progn (insert string)(point))))) + (set-extent-property extent 'invisible t) + (set-extent-end-glyph extent image)))) + (condition-case nil + (progn + (require 'image) + (defalias 'mime-image-type-available-p 'image-type-available-p) + (defun mime-image-create + (file-or-data &optional type data-p &rest props) + (if (and data-p (eq type 'xbm)) + (with-temp-buffer + (insert file-or-data) + (setq file-or-data + (mime-image-normalize-xbm-buffer (current-buffer))) + (apply #'create-image (nth 2 file-or-data) type data-p + (nconc + (list :width (car file-or-data) + :height (nth 1 file-or-data)) + props))) + (apply #'create-image file-or-data type data-p props))) + (defalias 'mime-image-insert 'insert-image)) + (error + (condition-case nil + (progn + (require (if (featurep 'mule) 'bitmap "")) + (defun mime-image-read-xbm-buffer (buffer) + (condition-case nil + (mapconcat #'bitmap-compose + (append (bitmap-decode-xbm + (bitmap-read-xbm-buffer + (current-buffer))) nil) "\n") + (error nil))) + (defun mime-image-insert (image string &optional area) + (insert image))) + (error + (defalias 'mime-image-read-xbm-buffer + 'mime-image-normalize-xbm-buffer) + (defun mime-image-insert (image string &optional area) + (save-restriction + (narrow-to-region (point)(point)) + (let ((face (gensym "mii"))) + (or (facep face) (make-face face)) + (set-face-stipple face image) + (let ((row (make-string (/ (car image) (frame-char-width)) ? )) + (height (/ (nth 1 image) (frame-char-height))) + (i 0)) + (while (< i height) + (set-text-properties (point) (progn (insert row)(point)) + (list 'face face)) + (insert "\n") + (setq i (1+ i))))))))) + + (defun mime-image-type-available-p (type) + (eq type 'xbm)) + + (defun mime-image-create (file-or-data &optional type data-p &rest props) + (when (or (null type) (eq type 'xbm)) + (with-temp-buffer + (if data-p + (insert file-or-data) + (insert-file-contents file-or-data)) + (mime-image-read-xbm-buffer (current-buffer)))))))) (defvar mime-image-format-alist '((image jpeg jpeg) @@ -157,74 +168,36 @@ (image xbm xbm) (image x-xbm xbm) (image x-xpixmap xpm) - (image x-pic pic) - (image x-mag mag) (image png png))) (dolist (rule mime-image-format-alist) - (let ((type (car rule)) - (subtype (nth 1 rule)) - (format (nth 2 rule))) - (when (image-inline-p format) - (ctree-set-calist-strictly - 'mime-preview-condition - (list (cons 'type type)(cons 'subtype subtype) - '(body . visible) - (cons 'body-presentation-method #'mime-display-image) - (cons 'image-format format)))))) - + (when (mime-image-type-available-p (nth 2 rule)) + (ctree-set-calist-strictly + 'mime-preview-condition + (list (cons 'type (car rule))(cons 'subtype (nth 1 rule)) + '(body . visible) + (cons 'body-presentation-method #'mime-display-image) + (cons 'image-format (nth 2 rule)))))) + ;;; @ content filter for images ;;; ;; (for XEmacs 19.12 or later) -(eval-when-compile - (defmacro mime-image-normalize-xbm (entity) - (` (with-temp-buffer - (mime-insert-entity-content (, entity)) - (let ((cur (current-buffer)) - width height) - (goto-char (point-min)) - (search-forward "width ") - (setq width (read cur)) - (goto-char (point-min)) - (search-forward "height ") - (setq height (read cur)) - (goto-char (point-min)) - (search-forward "{") - (delete-region (point-min) (point)) - (insert "\"") - (search-forward "}") - (delete-region (1- (point)) (point-max)) - (insert "\"") - (goto-char (point-min)) - (while (re-search-forward "[^\"0-9A-FXa-fx]+" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (search-forward "0x" nil t) - (replace-match "\\\\x")) - (goto-char (point-min)) - (, (if (featurep 'xemacs) - (` (vector 'xbm :data - (list width height (read cur)))) - '(` (image :type xbm :width (, width) :height (, height) - :data (, (read cur))))))))))) - (defun mime-display-image (entity situation) (message "Decoding image...") - (let* ((format (cdr (assq 'image-format situation))) - (image (if (or (featurep 'xemacs) (boundp 'image-types)) - (if (eq 'xbm format) - (mime-image-normalize-xbm entity) - (image-normalize format (mime-entity-content entity))) - (image-normalize format (mime-entity-content entity))))) - (if (image-invalid-glyph-p image) + (let ((format (cdr (assq 'image-format situation))) + image) + (setq image (mime-image-create (mime-entity-content entity) format 'data)) + (if (null image) (message "Invalid glyph!") - (image-insert-at-point image) - (message "Decoding image... done"))) - (static-when (featurep 'xemacs) - (insert "\n"))) - + (save-excursion + (mime-image-insert image "x") + (insert "\n") + (save-window-excursion + (set-window-buffer (selected-window)(current-buffer)) + (sit-for 0)) + (message "Decoding image... done"))))) ;;; @ end ;;; diff --git a/mime-pgp.el b/mime-pgp.el index 7012859..d3d66e1 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -1,4 +1,4 @@ -;;; mime-pgp.el --- mime-view internal methods foro PGP. +;;; mime-pgp.el --- mime-view internal methods for PGP. ;; Copyright (C) 1995,1996,1997,1998,1999 MORIOKA Tomohiko @@ -61,6 +61,8 @@ "S/MIME decryption of current region.") (autoload 'smime-verify-region "smime" "S/MIME verification of current region.") +(defvar smime-output-buffer) +(defvar smime-errors-buffer) ;;; @ Internal method for multipart/signed @@ -251,7 +253,7 @@ (format "%s-%s" (buffer-name) (mime-entity-number entity))) (mother (current-buffer)) (preview-buffer (concat "*Preview-" (buffer-name) "*"))) - (when (memq (or (cdr (assq 'smime-type situation)) enveloped-data) + (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data) '(enveloped-data signed-data)) (set-buffer (get-buffer-create new-name)) (let ((inhibit-read-only t) diff --git a/pgg-def.el b/pgg-def.el index c8fef62..1227996 100644 --- a/pgg-def.el +++ b/pgg-def.el @@ -32,9 +32,11 @@ :group 'mime) (defcustom pgg-default-scheme 'gpg - "Default PGP scheme" - :group 'symbol - :type 'string) + "Default PGP scheme." + :group 'pgg + :type '(choice (const :tag "GnuPG" gpg) + (const :tag "PGP 5" pgp5) + (const :tag "PGP" pgp))) (defcustom pgg-default-user-id (user-login-name) "User ID of your default identity." @@ -47,12 +49,12 @@ :type 'string) (defcustom pgg-encrypt-for-me nil - "Encrypt all outgoing messages with user's public key." + "If t, encrypt all outgoing messages with user's public key." :group 'pgg :type 'boolean) (defcustom pgg-cache-passphrase t - "Cache passphrase" + "If t, cache passphrase." :group 'pgg :type 'boolean) @@ -63,7 +65,7 @@ (defvar pgg-echo-buffer "*PGG-echo*") (defvar pgg-scheme nil - "Current scheme of PGP implementation") + "Current scheme of PGP implementation.") (defmacro pgg-truncate-key-identifier (key) `(if (> (length ,key) 8) (substring ,key 8) ,key)) diff --git a/pgg-gpg.el b/pgg-gpg.el index 2bcb3c7..0a715db 100644 --- a/pgg-gpg.el +++ b/pgg-gpg.el @@ -37,8 +37,8 @@ :type 'string) (defcustom pgg-gpg-shell-file-name "/bin/sh" - "File name to load inferior shells from. Bourne shell or its equivalent -\(not tcsh) is needed for \"2>\"." + "File name to load inferior shells from. +Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." :group 'pgg-gpg :type 'string) @@ -68,12 +68,12 @@ (defun pgg-gpg-process-region (start end passphrase program args) (let* ((errors-file-name - (concat temporary-file-directory + (concat temporary-file-directory (make-temp-name "pgg-errors"))) (status-file-name - (concat temporary-file-directory + (concat temporary-file-directory (make-temp-name "pgg-status"))) - (args + (args (append `("--status-fd" "3" ,@(if passphrase '("--passphrase-fd" "0")) @@ -91,46 +91,50 @@ (with-current-buffer (get-buffer-create output-buffer) (buffer-disable-undo) (erase-buffer)) - (as-binary-process - (setq process - (apply #'start-process-shell-command "*GnuPG*" output-buffer - program args))) - (set-process-sentinel process #'ignore) - (when passphrase - (process-send-string process (concat passphrase "\n"))) - (process-send-region process start end) - (process-send-eof process) - (while (eq 'run (process-status process)) - (accept-process-output process 5)) - (setq status (process-status process) - exit-status (process-exit-status process)) - (delete-process process) - (with-current-buffer output-buffer - (pgg-convert-lbt-region (point-min)(point-max) 'LF) + (unwind-protect + (progn + (as-binary-process + (setq process + (apply #'start-process-shell-command "*GnuPG*" output-buffer + program args))) + (set-process-sentinel process #'ignore) + (when passphrase + (process-send-string process (concat passphrase "\n"))) + (process-send-region process start end) + (process-send-eof process) + (while (eq 'run (process-status process)) + (accept-process-output process 5)) + (setq status (process-status process) + exit-status (process-exit-status process)) + (delete-process process) + (with-current-buffer output-buffer + (pgg-convert-lbt-region (point-min)(point-max) 'LF) - (if (memq status '(stop signal)) - (error "%s exited abnormally: '%s'" program exit-status)) - (if (= 127 exit-status) - (error "%s could not be found" program)) + (if (memq status '(stop signal)) + (error "%s exited abnormally: '%s'" program exit-status)) + (if (= 127 exit-status) + (error "%s could not be found" program)) - (set-buffer (get-buffer-create errors-buffer)) - (buffer-disable-undo) - (erase-buffer) - (insert-file-contents errors-file-name) - (delete-file errors-file-name) + (set-buffer (get-buffer-create errors-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents errors-file-name) - (set-buffer (get-buffer-create status-buffer)) - (buffer-disable-undo) - (erase-buffer) - (insert-file-contents status-file-name) - (delete-file status-file-name) - + (set-buffer (get-buffer-create status-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents status-file-name))) (if (and process (eq 'run (process-status process))) - (interrupt-process process))))) + (interrupt-process process)) + (condition-case nil + (progn + (delete-file status-file-name) + (delete-file errors-file-name)) + (file-error nil))))) (luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-gpg) string &optional type) - (let ((args (list "--with-colons" "--no-greeting" "--batch" + (let ((args (list "--with-colons" "--no-greeting" "--batch" (if type "--list-secret-keys" "--list-keys") string))) (with-current-buffer (get-buffer-create pgg-output-buffer) @@ -139,23 +143,23 @@ (apply #'call-process pgg-gpg-program nil t nil args) (goto-char (point-min)) (when (re-search-forward "^\\(sec\\|pub\\):" nil t) - (substring - (nth 3 (split-string + (substring + (nth 3 (split-string (buffer-substring (match-end 0) (progn (end-of-line)(point))) ":")) 8))))) -(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-gpg) +(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-gpg) start end recipients) (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) - (args + (args `("--batch" "--armor" "--always-trust" "--encrypt" ,@(if recipients - (apply #'append - (mapcar (lambda (rcpt) - (list "--remote-user" - (concat "\"" rcpt "\""))) + (apply #'append + (mapcar (lambda (rcpt) + (list "--remote-user" + (concat "\"" rcpt "\""))) (append recipients (if pgg-encrypt-for-me (list pgg-gpg-user-id))))))))) @@ -164,27 +168,27 @@ (pgg-process-when-success (pgg-convert-lbt-region (point-min)(point-max) 'LF)))) -(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-gpg) +(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-gpg) start end) (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) (passphrase - (pgg-read-passphrase + (pgg-read-passphrase (format "GnuPG passphrase for %s: " pgg-gpg-user-id) (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'encrypt))) (args '("--batch" "--decrypt"))) (pgg-gpg-process-region start end passphrase pgg-gpg-program args) (pgg-process-when-success nil))) -(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-gpg) +(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-gpg) start end &optional cleartext) (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) (passphrase - (pgg-read-passphrase + (pgg-read-passphrase (format "GnuPG passphrase for %s: " pgg-gpg-user-id) (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'sign))) - (args + (args (list (if cleartext "--clearsign" "--detach-sign") - "--armor" "--batch" "--verbose" + "--armor" "--batch" "--verbose" "--local-user" pgg-gpg-user-id)) (inhibit-read-only t) buffer-read-only) @@ -193,17 +197,17 @@ (pgg-process-when-success (pgg-convert-lbt-region (point-min)(point-max) 'LF) (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX - (let ((packet - (cdr (assq 2 (pgg-parse-armor-region + (let ((packet + (cdr (assq 2 (pgg-parse-armor-region (progn (beginning-of-line 2) (point)) (point-max)))))) (if pgg-cache-passphrase - (pgg-add-passphrase-cache + (pgg-add-passphrase-cache (cdr (assq 'key-identifier packet)) passphrase))))))) -(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-gpg) +(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-gpg) start end &optional signature) (let ((args '("--batch" "--verify"))) (when (stringp signature) @@ -230,7 +234,7 @@ (luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-gpg)) (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) - (args (list "--batch" "--export" "--armor" + (args (list "--batch" "--export" "--armor" (concat "\"" pgg-gpg-user-id "\"")))) (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args) (insert-buffer-substring pgg-output-buffer))) @@ -242,10 +246,10 @@ (set-buffer pgg-status-buffer) (goto-char (point-min)) (when (re-search-forward "^\\[GNUPG:] +IMPORT_RES +" nil t) - (setq status (buffer-substring (match-end 0) - (progn (end-of-line) + (setq status (buffer-substring (match-end 0) + (progn (end-of-line) (point))) - status (vconcat (mapcar #'string-to-int + status (vconcat (mapcar #'string-to-int (split-string status)))) (erase-buffer) (insert (format "Imported %d key(s). diff --git a/pgg-parse.el b/pgg-parse.el index 040ae1a..910b0ff 100644 --- a/pgg-parse.el +++ b/pgg-parse.el @@ -28,7 +28,7 @@ ;; This module is based on ;; [OpenPGP] RFC 2440: "OpenPGP Message Format" -;; by John W. Noerenberg, II , +;; by John W. Noerenberg, II , ;; Jon Callas , Lutz Donnerhacke , ;; Hal Finney and Rodney Thayer ;; (1998/11) @@ -72,7 +72,7 @@ (2 . ZLIB)) "Alist of the assigned number to the compression algorithm." :group 'pgg-parse - :type 'alist) + :type 'alist) (defcustom pgg-parse-signature-type-alist '((0 . "Signature of a binary document") @@ -81,7 +81,7 @@ (16 . "Generic certification of a User ID and Public Key packet") (17 . "Persona certification of a User ID and Public Key packet") (18 . "Casual certification of a User ID and Public Key packet") - (19 . "Positive certification of a User ID and Public Key packet") + (19 . "Positive certification of a User ID and Public Key packet") (24 . "Subkey Binding Signature") (31 . "Signature directly on a key") (32 . "Key revocation signature") @@ -102,7 +102,7 @@ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$" "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$" "^-----BEGIN PGP SIGNATURE-----\r?$") - "Armor headers") + "Armor headers.") (defmacro pgg-format-key-identifier (string) `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x" @@ -122,7 +122,7 @@ `(char-int (char-after (prog1 (point) (forward-char))))) (defmacro pgg-read-bytes-string (nbytes) - `(buffer-substring + `(buffer-substring (point) (prog1 (+ ,nbytes (point)) (forward-char ,nbytes)))) @@ -171,14 +171,13 @@ (format "%c%c%c" (logand (aref h 1) 255) (logand (lsh (aref h 2) -8) 255) - (logand (aref h 2) 255)))) - ) + (logand (aref h 2) 255))))) (defmacro pgg-parse-length-type (c) - `(cond + `(cond ((< ,c 192) (cons ,c 1)) ((< ,c 224) - (cons (+ (lsh (- ,c 192) 8) + (cons (+ (lsh (- ,c 192) 8) (pgg-byte-after (+ 2 (point))) 192) 2)) @@ -202,12 +201,11 @@ packet-bytes 0 header-bytes (1+ length-type)) (dotimes (i length-type) - (setq packet-bytes - (logior (lsh packet-bytes 8) - (pgg-byte-after (+ 1 i (point)))))) - ) + (setq packet-bytes + (logior (lsh packet-bytes 8) + (pgg-byte-after (+ 1 i (point))))))) (setq content-tag (logand 63 ptag) - length-type (pgg-parse-length-type + length-type (pgg-parse-length-type (pgg-byte-after (1+ (point)))) packet-bytes (car length-type) header-bytes (1+ (cdr length-type)))) @@ -236,23 +234,23 @@ ;; 12 -- Trust Packet (13 ;User ID Packet (pgg-read-body-string ptag)) - ;; 14 -- Public Subkey Packet + ;; 14 -- Public Subkey Packet ;; 60 .. 63 -- Private or Experimental Values )) (defun pgg-parse-packets (&optional header-parser body-parser) (let ((header-parser - (or header-parser + (or header-parser (function pgg-parse-packet-header))) (body-parser - (or body-parser + (or body-parser (function pgg-parse-packet))) result ptag) (while (> (point-max) (1+ (point))) (setq ptag (funcall header-parser)) (pgg-skip-header ptag) - (push (cons (car ptag) - (save-excursion + (push (cons (car ptag) + (save-excursion (funcall body-parser ptag))) result) (if (zerop (nth 1 ptag)) @@ -269,11 +267,11 @@ (defun pgg-parse-signature-subpacket (ptag) (case (car ptag) (2 ;signature creation time - (cons 'creation-time + (cons 'creation-time (let ((bytes (pgg-read-bytes 4))) (pgg-parse-time-field bytes)))) (3 ;signature expiration time - (cons 'signature-expiry + (cons 'signature-expiry (let ((bytes (pgg-read-bytes 4))) (pgg-parse-time-field bytes)))) (4 ;exportable certification @@ -281,12 +279,12 @@ (5 ;trust signature (cons 'trust-level (pgg-read-byte))) (6 ;regular expression - (cons 'regular-expression + (cons 'regular-expression (pgg-read-body-string ptag))) (7 ;revocable (cons 'revocability (pgg-read-byte))) (9 ;key expiration time - (cons 'key-expiry + (cons 'key-expiry (let ((bytes (pgg-read-bytes 4))) (pgg-parse-time-field bytes)))) ;; 10 = placeholder for backward compatibility @@ -304,13 +302,12 @@ (cons 'notation (let ((name-bytes (pgg-read-bytes 2)) (value-bytes (pgg-read-bytes 2))) - (cons (pgg-read-bytes-string + (cons (pgg-read-bytes-string (logior (lsh (car name-bytes) 8) (nth 1 name-bytes))) - (pgg-read-bytes-string + (pgg-read-bytes-string (logior (lsh (car value-bytes) 8) - (nth 1 value-bytes)))))) - ) + (nth 1 value-bytes))))))) (21 ;preferred hash algorithms (cons 'preferred-hash-algorithm (cdr (assq (pgg-read-byte) @@ -338,16 +335,16 @@ (let* ((signature-version (pgg-byte-after)) (result (list (cons 'version signature-version))) hashed-material field n) - (cond + (cond ((= signature-version 3) (pgg-skip-bytes 2) (setq hashed-material (pgg-read-bytes 5)) - (pgg-set-alist result - 'signature-type + (pgg-set-alist result + 'signature-type (cdr (assq (pop hashed-material) pgg-parse-signature-type-alist))) (pgg-set-alist result - 'creation-time + 'creation-time (pgg-parse-time-field hashed-material)) (pgg-set-alist result 'key-identifier @@ -356,16 +353,15 @@ (pgg-set-alist result 'public-key-algorithm (pgg-read-byte)) (pgg-set-alist result - 'hash-algorithm (pgg-read-byte)) - ) + 'hash-algorithm (pgg-read-byte))) ((= signature-version 4) (pgg-skip-bytes 1) (pgg-set-alist result - 'signature-type + 'signature-type (cdr (assq (pgg-read-byte) pgg-parse-signature-type-alist))) (pgg-set-alist result - 'public-key-algorithm + 'public-key-algorithm (pgg-read-byte)) (pgg-set-alist result 'hash-algorithm (pgg-read-byte)) @@ -376,11 +372,10 @@ (narrow-to-region (point)(+ n (point))) (nconc result (mapcar (function cdr) ;remove packet types - (pgg-parse-packets + (pgg-parse-packets #'pgg-parse-signature-subpacket-header #'pgg-parse-signature-subpacket))) - (goto-char (point-max))) - ) + (goto-char (point-max)))) (when (>= 10000 (setq n (pgg-read-bytes 2) n (logior (lsh (car n) 8) (nth 1 n)))) @@ -388,11 +383,9 @@ (narrow-to-region (point)(+ n (point))) (nconc result (mapcar (function cdr) ;remove packet types - (pgg-parse-packets + (pgg-parse-packets #'pgg-parse-signature-subpacket-header - #'pgg-parse-signature-subpacket))) - )) - )) + #'pgg-parse-signature-subpacket))))))) (setcdr (setq field (assq 'public-key-algorithm result)) @@ -410,7 +403,7 @@ 'version (pgg-read-byte)) (pgg-set-alist result 'key-identifier - (pgg-format-key-identifier + (pgg-format-key-identifier (pgg-read-bytes-string 8))) (pgg-set-alist result 'public-key-algorithm @@ -442,16 +435,14 @@ (pgg-set-alist result 'key-expiry (pgg-read-bytes 2)) (pgg-set-alist result - 'public-key-algorithm (pgg-read-byte)) - ) + 'public-key-algorithm (pgg-read-byte))) ((= 4 key-version) (pgg-set-alist result 'creation-time (let ((bytes (pgg-read-bytes 4))) (pgg-parse-time-field bytes))) (pgg-set-alist result - 'public-key-algorithm (pgg-read-byte)) - )) + 'public-key-algorithm (pgg-read-byte)))) (setcdr (setq field (assq 'public-key-algorithm result)) @@ -469,12 +460,12 @@ (mime-decode-region (point-min) marker "base64") (static-when (fboundp 'pgg-parse-crc24-string ) (or pgg-ignore-packet-checksum - (string-equal + (string-equal (funcall (mel-find-function 'mime-encode-string "base64") - (pgg-parse-crc24-string + (pgg-parse-crc24-string (buffer-substring (point-min)(point-max)))) checksum) - (error "PGP packet checksum does not match."))))) + (error "PGP packet checksum does not match"))))) (defun pgg-decode-armor-region (start end) (save-restriction diff --git a/pgg-pgp.el b/pgg-pgp.el index e7e2ee7..4b033e5 100644 --- a/pgg-pgp.el +++ b/pgg-pgp.el @@ -31,14 +31,14 @@ "PGP 2.* and 6.* interface" :group 'pgg) -(defcustom pgg-pgp-program "pgp" +(defcustom pgg-pgp-program "pgp" "PGP 2.* and 6.* executable." :group 'pgg-pgp :type 'string) (defcustom pgg-pgp-shell-file-name "/bin/sh" - "File name to load inferior shells from. Bourne shell or its equivalent -\(not tcsh) is needed for \"2>\"." + "File name to load inferior shells from. +Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." :group 'pgg-pgp :type 'string) @@ -56,7 +56,7 @@ (luna-define-class pgg-scheme-pgp (pgg-scheme))) (defvar pgg-pgp-user-id nil - "GnuPG ID of your default identity.") + "PGP ID of your default identity.") (defvar pgg-scheme-pgp-instance nil) @@ -68,10 +68,10 @@ (defun pgg-pgp-process-region (start end passphrase program args) (let* ((errors-file-name - (concat temporary-file-directory + (concat temporary-file-directory (make-temp-name "pgg-errors"))) - (args - (append args + (args + (append args pgg-pgp-extra-args (list (concat "2>" errors-file-name)))) (shell-file-name pgg-pgp-shell-file-name) @@ -85,38 +85,41 @@ (erase-buffer)) (when passphrase (setenv "PGPPASSFD" "0")) - (as-binary-process - (setq process - (apply #'start-process-shell-command "*PGP*" output-buffer - program args))) - (set-process-sentinel process #'ignore) - (when passphrase - (process-send-string process (concat passphrase "\n"))) - (process-send-region process start end) - (process-send-eof process) - (while (eq 'run (process-status process)) - (accept-process-output process 5)) - (setq status (process-status process) - exit-status (process-exit-status process)) - (delete-process process) - (with-current-buffer output-buffer - (pgg-convert-lbt-region (point-min)(point-max) 'LF) - - (if (memq status '(stop signal)) - (error "%s exited abnormally: '%s'" program exit-status)) - (if (= 127 exit-status) - (error "%s could not be found" program)) - - (set-buffer (get-buffer-create errors-buffer)) - (buffer-disable-undo) - (erase-buffer) - (insert-file-contents errors-file-name) - (delete-file errors-file-name) - + (unwind-protect + (progn + (as-binary-process + (setq process + (apply #'start-process-shell-command "*PGP*" output-buffer + program args))) + (set-process-sentinel process #'ignore) + (when passphrase + (process-send-string process (concat passphrase "\n"))) + (process-send-region process start end) + (process-send-eof process) + (while (eq 'run (process-status process)) + (accept-process-output process 5)) + (setq status (process-status process) + exit-status (process-exit-status process)) + (delete-process process) + (with-current-buffer output-buffer + (pgg-convert-lbt-region (point-min)(point-max) 'LF) + + (if (memq status '(stop signal)) + (error "%s exited abnormally: '%s'" program exit-status)) + (if (= 127 exit-status) + (error "%s could not be found" program)) + + (set-buffer (get-buffer-create errors-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents errors-file-name))) (if (and process (eq 'run (process-status process))) - (interrupt-process process))))) + (interrupt-process process)) + (condition-case nil + (delete-file errors-file-name) + (file-error nil))))) -(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp) +(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp) string &optional type) (let ((args (list "+batchmode" "+language=en" "-kv" string))) (with-current-buffer (get-buffer-create pgg-output-buffer) @@ -129,15 +132,15 @@ (buffer-substring (point)(+ 8 (point)))) ((re-search-forward "^Type" nil t);PGP 6.* (beginning-of-line 2) - (substring - (nth 2 (split-string + (substring + (nth 2 (split-string (buffer-substring (point)(progn (end-of-line) (point))))) 2)))))) -(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp) +(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp) start end recipients) (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) - (args + (args `("+encrypttoself=off +verbose=1" "+batchmode" "+language=us" "-fate" ,@(if recipients @@ -148,26 +151,26 @@ (pgg-pgp-process-region start end nil pgg-pgp-program args) (pgg-process-when-success nil))) -(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp) +(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp) start end) (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (passphrase - (pgg-read-passphrase + (pgg-read-passphrase (format "PGP passphrase for %s: " pgg-pgp-user-id) (pgg-scheme-lookup-key scheme pgg-pgp-user-id 'encrypt))) - (args + (args '("+verbose=1" "+batchmode" "+language=us" "-f"))) (pgg-pgp-process-region start end passphrase pgg-pgp-program args) (pgg-process-when-success nil))) -(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp) +(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp) start end &optional clearsign) (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (passphrase - (pgg-read-passphrase + (pgg-read-passphrase (format "PGP passphrase for %s: " pgg-pgp-user-id) (pgg-scheme-lookup-key scheme pgg-pgp-user-id 'sign))) - (args + (args (list (if clearsign "-fast" "-fbast") "+verbose=1" "+language=us" "+batchmode" "-u" pgg-pgp-user-id))) @@ -175,17 +178,17 @@ (pgg-process-when-success (goto-char (point-min)) (when (re-search-forward "^-+BEGIN PGP" nil t);XXX - (let ((packet - (cdr (assq 2 (pgg-parse-armor-region + (let ((packet + (cdr (assq 2 (pgg-parse-armor-region (progn (beginning-of-line 2) (point)) (point-max)))))) (if pgg-cache-passphrase - (pgg-add-passphrase-cache + (pgg-add-passphrase-cache (cdr (assq 'key-identifier packet)) passphrase))))))) -(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp) +(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp) start end &optional signature) (let* ((basename (expand-file-name "pgg" temporary-file-directory)) (orig-file (make-temp-name basename)) @@ -210,14 +213,14 @@ (progn (beginning-of-line 2) (point))))) (goto-char (point-min)) (when (re-search-forward "^\\.$" nil t) - (delete-region (point-min) + (delete-region (point-min) (progn (beginning-of-line 2) (point))))))) (luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-pgp)) (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (args - (list "+verbose=1" "+batchmode" "+language=us" "-kxaf" + (list "+verbose=1" "+batchmode" "+language=us" "-kxaf" (concat "\"" pgg-pgp-user-id "\"")))) (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args) (insert-buffer-substring pgg-output-buffer))) @@ -227,8 +230,8 @@ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (basename (expand-file-name "pgg" temporary-file-directory)) (key-file (make-temp-name basename)) - (args - (list "+verbose=1" "+batchmode" "+language=us" "-kaf" + (args + (list "+verbose=1" "+batchmode" "+language=us" "-kaf" key-file))) (write-region-as-raw-text-CRLF start end key-file) (pgg-pgp-process-region start end nil pgg-pgp-program args) diff --git a/pgg-pgp5.el b/pgg-pgp5.el index 2b26a3f..cde2b6f 100644 --- a/pgg-pgp5.el +++ b/pgg-pgp5.el @@ -31,29 +31,29 @@ "PGP 5.* interface" :group 'pgg) -(defcustom pgg-pgp5-pgpe-program "pgpe" +(defcustom pgg-pgp5-pgpe-program "pgpe" "PGP 5.* 'pgpe' executable." :group 'pgg-pgp5 :type 'string) -(defcustom pgg-pgp5-pgps-program "pgps" +(defcustom pgg-pgp5-pgps-program "pgps" "PGP 5.* 'pgps' executable." :group 'pgg-pgp5 :type 'string) -(defcustom pgg-pgp5-pgpk-program "pgpk" +(defcustom pgg-pgp5-pgpk-program "pgpk" "PGP 5.* 'pgpk' executable." :group 'pgg-pgp5 :type 'string) -(defcustom pgg-pgp5-pgpv-program "pgpv" +(defcustom pgg-pgp5-pgpv-program "pgpv" "PGP 5.* 'pgpv' executable." :group 'pgg-pgp5 :type 'string) (defcustom pgg-pgp5-shell-file-name "/bin/sh" - "File name to load inferior shells from. Bourne shell or its equivalent -\(not tcsh) is needed for \"2>\"." + "File name to load inferior shells from. +Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." :group 'pgg-pgp5 :type 'string) @@ -63,7 +63,7 @@ :type 'string) (defcustom pgg-pgp5-extra-args nil - "Extra arguments for every PGP invocation." + "Extra arguments for every PGP 5.* invocation." :group 'pgg-pgp5 :type 'string) @@ -71,7 +71,7 @@ (luna-define-class pgg-scheme-pgp5 (pgg-scheme))) (defvar pgg-pgp5-user-id nil - "GnuPG ID of your default identity.") + "PGP 5.* ID of your default identity.") (defvar pgg-scheme-pgp5-instance nil) @@ -83,10 +83,10 @@ (defun pgg-pgp5-process-region (start end passphrase program args) (let* ((errors-file-name - (concat temporary-file-directory + (concat temporary-file-directory (make-temp-name "pgg-errors"))) - (args - (append args + (args + (append args pgg-pgp5-extra-args (list (concat "2>" errors-file-name)))) (shell-file-name pgg-pgp5-shell-file-name) @@ -100,38 +100,41 @@ (erase-buffer)) (when passphrase (setenv "PGPPASSFD" "0")) - (as-binary-process - (setq process - (apply #'start-process-shell-command "*PGP*" output-buffer - program args))) - (set-process-sentinel process #'ignore) - (when passphrase - (process-send-string process (concat passphrase "\n"))) - (process-send-region process start end) - (process-send-eof process) - (while (eq 'run (process-status process)) - (accept-process-output process 5)) - (setq status (process-status process) - exit-status (process-exit-status process)) - (delete-process process) - (with-current-buffer output-buffer - (pgg-convert-lbt-region (point-min)(point-max) 'LF) - - (if (memq status '(stop signal)) - (error "%s exited abnormally: '%s'" program exit-status)) - (if (= 127 exit-status) - (error "%s could not be found" program)) - - (set-buffer (get-buffer-create errors-buffer)) - (buffer-disable-undo) - (erase-buffer) - (insert-file-contents errors-file-name) - (delete-file errors-file-name) - + (unwind-protect + (progn + (as-binary-process + (setq process + (apply #'start-process-shell-command "*PGP*" output-buffer + program args))) + (set-process-sentinel process #'ignore) + (when passphrase + (process-send-string process (concat passphrase "\n"))) + (process-send-region process start end) + (process-send-eof process) + (while (eq 'run (process-status process)) + (accept-process-output process 5)) + (setq status (process-status process) + exit-status (process-exit-status process)) + (delete-process process) + (with-current-buffer output-buffer + (pgg-convert-lbt-region (point-min)(point-max) 'LF) + + (if (memq status '(stop signal)) + (error "%s exited abnormally: '%s'" program exit-status)) + (if (= 127 exit-status) + (error "%s could not be found" program)) + + (set-buffer (get-buffer-create errors-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents errors-file-name))) (if (and process (eq 'run (process-status process))) - (interrupt-process process))))) + (interrupt-process process)) + (condition-case nil + (delete-file errors-file-name) + (file-error nil))))) -(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp5) +(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp5) string &optional type) (let ((args (list "+language=en" "-l" string))) (with-current-buffer (get-buffer-create pgg-output-buffer) @@ -140,64 +143,64 @@ (apply #'call-process pgg-pgp5-pgpk-program nil t nil args) (goto-char (point-min)) (when (re-search-forward "^sec" nil t) - (substring - (nth 2 (split-string + (substring + (nth 2 (split-string (buffer-substring (match-end 0)(progn (end-of-line)(point))))) 2))))) -(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp5) +(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp5) start end recipients) (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) - (args + (args `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1" ,@(if recipients - (apply #'append - (mapcar (lambda (rcpt) - (list "-r" - (concat "\"" rcpt "\""))) + (apply #'append + (mapcar (lambda (rcpt) + (list "-r" + (concat "\"" rcpt "\""))) (append recipients (if pgg-encrypt-for-me (list pgg-pgp5-user-id))))))))) (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args) (pgg-process-when-success nil))) -(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp5) +(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp5) start end) (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase - (pgg-read-passphrase + (pgg-read-passphrase (format "PGP passphrase for %s: " pgg-pgp5-user-id) (pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'encrypt))) - (args + (args '("+verbose=1" "+batchmode=1" "+language=us" "-f"))) (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args) (pgg-process-when-success nil))) -(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp5) +(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp5) start end &optional clearsign) (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase - (pgg-read-passphrase + (pgg-read-passphrase (format "PGP passphrase for %s: " pgg-pgp5-user-id) (pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'sign))) - (args + (args (list (if clearsign "-fat" "-fbat") "+verbose=1" "+language=us" "+batchmode=1" "-u" pgg-pgp5-user-id))) (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args) (pgg-process-when-success (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX - (let ((packet - (cdr (assq 2 (pgg-parse-armor-region + (let ((packet + (cdr (assq 2 (pgg-parse-armor-region (progn (beginning-of-line 2) (point)) (point-max)))))) (if pgg-cache-passphrase - (pgg-add-passphrase-cache + (pgg-add-passphrase-cache (cdr (assq 'key-identifier packet)) passphrase))))))) -(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp5) +(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp5) start end &optional signature) (let* ((basename (expand-file-name "pgg" temporary-file-directory)) (orig-file (make-temp-name basename)) @@ -216,12 +219,17 @@ (if signature (delete-file signature)) (with-current-buffer pgg-errors-buffer (goto-char (point-min)) - (re-search-forward "^Good signature" nil t)))) + (if (re-search-forward "^Good signature" nil t) + (progn + (set-buffer pgg-output-buffer) + (insert-buffer-substring pgg-errors-buffer) + t) + nil)))) (luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-pgp5)) (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (args - (list "+verbose=1" "+batchmode=1" "+language=us" "-x" + (list "+verbose=1" "+batchmode=1" "+language=us" "-x" (concat "\"" pgg-pgp5-user-id "\"")))) (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args) (insert-buffer-substring pgg-output-buffer))) @@ -231,8 +239,8 @@ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (basename (expand-file-name "pgg" temporary-file-directory)) (key-file (make-temp-name basename)) - (args - (list "+verbose=1" "+batchmode=1" "+language=us" "-a" + (args + (list "+verbose=1" "+batchmode=1" "+language=us" "-a" key-file))) (write-region-as-raw-text-CRLF start end key-file) (pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args) diff --git a/pgg.el b/pgg.el index 06b4375..6975eef 100644 --- a/pgg.el +++ b/pgg.el @@ -114,7 +114,7 @@ (luna-define-internal-accessors 'pgg-scheme)) (luna-define-generic pgg-scheme-lookup-key (scheme string &optional type) - "Search keys associated with STRING") + "Search keys associated with STRING.") (luna-define-generic pgg-scheme-encrypt-region (scheme start end recipients) "Encrypt the current region between START and END.") @@ -128,15 +128,13 @@ (luna-define-generic pgg-scheme-verify-region (scheme start end &optional signature) - "Verify region between START and END -as the detached signature SIGNATURE.") + "Verify region between START and END as the detached signature SIGNATURE.") (luna-define-generic pgg-scheme-insert-key (scheme) "Insert public key at point.") (luna-define-generic pgg-scheme-snarf-keys-region (scheme start end) - "Add all public keys in region between START -and END to the keyring.") + "Add all public keys in region between START and END to the keyring.") ;;; @ utility functions ;;; @@ -167,12 +165,9 @@ and END to the keyring.") ,@body))) (defun pgg-temp-buffer-show-function (buffer) - (if (one-window-p (selected-window)) - (let ((window (split-window-vertically - (- (window-height) - (/ (window-height) 5))))) - (set-window-buffer window buffer)) - (display-buffer buffer))) + (let ((window (split-window-vertically))) + (set-window-buffer window buffer) + (shrink-window-if-larger-than-buffer window))) (defun pgg-display-output-buffer (start end status) (if status @@ -180,7 +175,7 @@ and END to the keyring.") (delete-region start end) (insert-buffer-substring pgg-output-buffer) (decode-coding-region start (point) buffer-file-coding-system)) - (let ((temp-buffer-show-function + (let ((temp-buffer-show-function (function pgg-temp-buffer-show-function))) (with-output-to-temp-buffer pgg-echo-buffer (set-buffer standard-output) @@ -260,7 +255,7 @@ and END to the keyring.") (list (region-beginning)(region-end) (split-string (read-string "Recipients: ") "[ \t,]+"))) (let* ((entity (pgg-make-scheme pgg-default-scheme)) - (status + (status (pgg-save-coding-system start end (pgg-scheme-encrypt-region entity (point-min)(point-max) rcpts)))) (when (interactive-p) @@ -317,7 +312,7 @@ signer's public key from `pgg-default-keyserver-address'." (buffer-disable-undo) (set-buffer-multibyte nil) (insert-file-contents signature) - (cdr (assq 2 (pgg-decode-armor-region + (cdr (assq 2 (pgg-decode-armor-region (point-min)(point-max))))))) (scheme (or pgg-scheme diff --git a/semi-setup.el b/semi-setup.el index dffe33a..ecdf2ae 100644 --- a/semi-setup.el +++ b/semi-setup.el @@ -41,13 +41,10 @@ it is used as hook to set." )) -;; for image/* and X-Face +;; for image/* (defvar mime-setup-enable-inline-image (and window-system - (or (featurep 'xemacs) - (and (featurep 'mule) - (or (fboundp 'create-image) - (module-installed-p 'bitmap))))) + (or (featurep 'xemacs)(featurep 'mule))) "*If it is non-nil, semi-setup sets up to use mime-image.") (if mime-setup-enable-inline-image diff --git a/smime.el b/smime.el index 8bd0ad8..d01ee0d 100644 --- a/smime.el +++ b/smime.el @@ -170,31 +170,15 @@ (smime-parse-attribute (buffer-substring (point)(progn (end-of-line)(point)))))))) -(static-condition-case nil - (directory-files nil nil nil nil nil) - (wrong-number-of-arguments - (defmacro smime-directory-files - (directory &optional full match nosort files-only) - (if files-only - `(delq nil (mapcar - (lambda (file) - ,(if (eq files-only t) - `(if (file-directory-p file) nil file) - `(if (file-directory-p file) file nil))) - (directory-files ,directory ,full ,match ,nosort))) - `(directory-files ,directory ,full ,match ,nosort)))) - (error - (defalias 'smime-directory-files 'directory-files))) - (defsubst smime-find-certificate (attr) - (let ((files (if (file-directory-p smime-certificate-directory) - (delq nil (mapcar (lambda (file) - (if (file-directory-p file) nil - file)) - (directory-files - smime-certificate-directory - 'full))) - nil))) + (let ((files + (and (file-directory-p smime-certificate-directory) + (delq nil (mapcar (lambda (file) + (if (file-directory-p file) nil + file)) + (directory-files + smime-certificate-directory + 'full)))))) (catch 'found (while files (if (or (string-equal @@ -313,13 +297,11 @@ If the optional 3rd argument SIGNATURE is non-nil, it is treated as the detached signature of the current region." (let* ((basename (expand-file-name "smime" temporary-file-directory)) (orig-file (make-temp-name basename)) - (args (list "-qs" signature)) (orig-mode (default-file-modes))) (unwind-protect (progn (set-default-file-modes 448) - (write-region-as-binary start end orig-file) - ) + (write-region-as-binary start end orig-file)) (set-default-file-modes orig-mode)) (with-temp-buffer (insert-file-contents-as-binary signature)