+2000-02-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * 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 <tomo@m17n.org>
* mime-view.el (mime-delq-null-situation): Accept multiple ignored
* semi-setup.el: Use `eval-after-load' for text/html related
setting.
+2000-02-21 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * 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 <ueno@ueda.info.waseda.ac.jp>
+
+ * 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 <tomo@m17n.org>
* mime-view.el (mime-view-define-keymap): Change binding of
* mime-view.el (mime-preview-follow-current-entity): Fix problem
in multipart entity.
+2000-02-07 Yoshiki Hayashi <yoshiki@xemacs.org>
+
+ * 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 <Makoto.Nakagawa@jp.compaq.com>
+
+ * pgg-pgp5.el (pgg-scheme-verify-region): Copy the contents of
+ `pgg-errors-buffer' to `pgg-output-buffer'.
+
+2000-02-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-temp-buffer-show-function): Don't check if the
+ selected window is the only window.
+
2000-02-01 MORIOKA Tomohiko <tomo@m17n.org>
* semi-setup.el (mime-setup-enable-inline-image): Use "(fboundp
+++ /dev/null
-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
"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
"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
(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)))
))))
(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
(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
;;; 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)
(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
;;;
-;;; 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
"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
(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)
: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."
: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)
(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))
: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)
(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"))
(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)
(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)))))))))
(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)
(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)
(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)))
(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).
;; This module is based on
;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
-;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
+;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
;; Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
;; Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
;; (1998/11)
(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")
(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")
"^-----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"
`(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))))
(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))
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))))
;; 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))
(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
(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
(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)
(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
(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))
(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))))
(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))
'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
(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))
(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
"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)
(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)
(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)
(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)
(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
(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)))
(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))
(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)))
(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)
"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)
: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)
(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)
(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)
(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)
(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))
(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)))
(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)
(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.")
(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
;;;
,@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
(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)
(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)
(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
))
-;; 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
(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
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)
projects / elisp / semi.git / commitdiff