+2000-10-19 Takanori Saneto <sanewo@ba2.so-net.ne.jp>
+
+ * pgg-pgp.el (pgg-pgp-process-region): bind process-environment
+ locally so that setenv's effect won't last forever.
+ pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
+
+2000-09-29 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime-edit.el (mime-file-types): Fix to use application/msword
+ instead of application/winword.
+
+2000-08-11 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-display-text/plain): Display warning message
+ when `mime-insert-text-content' fails.
+
+2000-08-04 Daiki Ueno <ueno@unixuser.org>
+
+ * pgg-gpg.el (pgg-gpg-process-region): Don't bind
+ coding-system-for-read.
+
+2000-07-04 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * mime-image.el (mime-image-insert) [XEmacs]:
+ Insert `string' only if it is non-nil.
+
+2000-06-27 Daiki Ueno <ueno@unixuser.org>
+
+ * mime-image.el (mime-image-insert): Synch with the latest image.el.
+ (mime-display-image): Don't pass underlying string "x".
+
+2000-06-09 Daiki Ueno <ueno@unixuser.org>
+
+ * mime-edit.el (mime-edit-insert-key): Insert a text tag when
+ the buffer has any trailing text.
+
+2000-06-05 Shugo Maeda <shugo@ruby-lang.org>
+
+ * pgg-gpg.el (pgg-scheme-insert-key): Don't quote user id.
+
+2000-05-21 Daiki Ueno <ueno@unixuser.org>
+
+ * pgg-gpg.el (pgg-gpg-process-region): Abolish redundant nconc.
+
+2000-05-16 Daiki Ueno <ueno@unixuser.org>
+
+ * mime-image.el (mime-image-create) [XEmacs]: Don't call
+ `make-image-instance' directly.
+
+2000-05-02 Daiki Ueno <ueno@unixuser.org>
+
+ * pgg-gpg.el (pgg-scheme-encrypt-region): Don't quote recipient;
+ concatenate all arguments destructively.
+
+2000-04-13 Daiki Ueno <ueno@unixuser.org>
+
+ * pgg-gpg.el: Fix author's mailing address.
+ (pgg-gpg-process-region): Add --output option; set status fd to 2.
+ (pgg-gpg-possibly-cache-passphrase): New function.
+ (pgg-gpg-shell-file-name): Abolish.
+ (pgg-gpg-shell-command-switch): Abolish.
+ (pgg-scheme-lookup-key): Work on temp buffer.
+
+2000-03-01 Yoshiki Hayashi <yoshiki@xemacs.org>
+
+ * mime-image.el (mime-display-image): Don't wait for redisplay.
+
+\f
+2000-07-12 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * REMI: Version 1.14.2 (Hokuhoku-\e-DÒshima)\e-A released.
+
+ * README.en (Required environment): Modify for FLIM-Chao 1.14.1.
+
+2000-07-11 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime-pgp.el (mime-view-application/pgp): Setup local variable
+ `mime-view-temp-message-buffer' of preview-buffer.
+ (mime-view-application/pkcs7-mime): Likewise.
+
+ * mime-play.el
+ (mime-preview-quitting-method-for-mime-show-message-mode): Don't
+ use `mime-entity-buffer'; refer `mime-view-temp-message-buffer'.
+ (mime-store-message/partial-piece): Use
+ `insert-file-contents-as-binary' instead of
+ `(as-binary-input-file (insert-file-contents ...))'; use
+ `write-region-as-binary' instead of
+ `(as-binary-output-file (write-region ...)); setup local variable
+ `mime-view-temp-message-buffer' of preview-buffer.
+
+2000-06-23 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime-edit.el (mime-edit-preview-message): Set up local variable
+ `mime-edit-temp-message-buffer'.
+ (mime-edit-quitting-method): Refer `mime-edit-temp-message-buffer'
+ to avoid to use `mime-entity-buffer'.
+
+2000-06-21 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime-view.el (mime-view-mode): Use
+ `mime-entity-set-content-type' and `mime-entity-set-encoding'
+ instead of `mime-entity-set-content-type-internal' and
+ `mime-entity-set-encoding-internal'.
+
+ * mime-w3.el (mime-preview-text/html): Use
+ `mime-find-root-entity'.
+
+2000-05-25 Tanaka Akira <akr@m17n.org>
+
+ * README.en: Update for CVS via SSH.
+
+2000-04-28 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime-edit.el (mime-charset-type-list): Add `iso-2022-jp-3'.
+
+\f
+2000-03-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * REMI: Version 1.14.1 (Mushigawa\e-Dòsugi)\e-A released.
+
+2000-03-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-view-define-keymap): Add new binding
+ `mime-preview-show-header' for C-c C-v C-f and C-c C-v h; add new
+ binding `mime-preview-show-content' for C-c C-v C-c; add new
+ binding `mime-preview-hide-header' for C-c C-d C-f and C-c C-d h;
+ add new binding `mime-preview-hide-content' for C-c C-d C-c.
+ (mime-preview-toggle-display): New function.
+ (mime-preview-toggle-header): Add new optional argument
+ `force-visible'; use `mime-preview-toggle-display'.
+ (mime-preview-toggle-content): Likewise.
+ (mime-preview-show-header): New function.
+ (mime-preview-show-content): New function.
+ (mime-preview-hide-header): New function.
+ (mime-preview-hide-content): New function.
+
+2000-02-25 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-situation-examples-file-coding-system): New
+ variable.
+ (mime-save-situation-examples): Use `with-temp-buffer'; try to
+ save as `mime-situation-examples-file-coding-system'.
+ - Use with-temp-buffer to load `mime-situation-examples-file';
+ setup `mime-situation-examples-file-coding-system' when
+ mime-situation-examples-file is loaded;
+
+2000-02-25 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-view-define-keymap): Change keybind for
+ `mime-preview-toggle-header' to C-c C-t h and C-c C-t C-f.
+
+2000-02-24 Mito <mit@nines.nec.co.jp>
+
+ * mime-edit.el (mime-edit-normalize-body): Fix number of arguments
+ against enriched-encode.
+
+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
+ values.
+ (mime-unify-situations): t is also regarded as an ignored-value.
+ (mime-preview-follow-current-entity): Eliminate unused local
+ variable `str'.
+
+2000-02-22 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-play.el (mime-play-find-every-situations): Renamed from
+ `mime-view-find-every-situations'.
+
+ * mime-view.el (mime-view-find-every-situations): Moved to
+ mime-play.el.
+
+2000-02-22 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-play.el (mime-play-entity): Specify
+ `mime-view-find-every-situations' as an optional argument
+ `every-situations'.
+
+ * mime-view.el (mime-unify-situations): Add new optional argument
+ `every-situations'; use it instead of
+ `mime-view-find-every-situations'.
+ (mime-display-multipart/alternative): Modify `body' property
+ instead of `body-presentation-method' property of
+ preview-situation.
+
+ * 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-preview-toggle-content' from C-c C-t C-b to C-c C-t C-c.
+ (mime-preview-toggle-content): Renamed from
+ `mime-preview-toggle-body'.
+
+\f
+2000-02-17 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * REMI: Version 1.14.0 (Uragawara) released.
+
+2000-02-17 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-view-define-keymap): Add new binding
+ `mime-preview-toggle-body' for C-c C-t C-b.
+ (mime-preview-toggle-body): New command.
+
+ * semi-def.el (mime-add-button): Don't use overlay.
+
+2000-02-17 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-preview-condition): Add default setting of
+ multipart; declare body of message/partial, message/rfc822 and
+ message/news are visible.
+ (mime-display-entity): Check `*body' or `body' property of
+ situation.
+
+2000-02-17 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-display-entity): Find
+ `header-presentation-method' only if `header-is-visible'.
+
+2000-02-10 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-display-entity): Don't use
+ `mime-goto-header-start-point'.
+
+2000-02-10 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-display-message): Use `major-mode' of
+ current-buffer as default value of `original-major-mode'; don't
+ use `mime-entity-header-buffer'.
+ (mime-preview-follow-current-entity): Use `mime-insert-header' to
+ insert header; don't use `mime-entity-header-buffer',
+ `mime-entity-header-start-point' and
+ `mime-entity-header-end-point'.
+
+2000-02-10 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-preview-follow-current-entity): Use
+ `mime-view-entity-body' to find body.
+
+2000-02-10 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-preview-find-boundary-info): Fix problem when
+ entity is in boundary of mother entity.
+ (mime-preview-follow-current-entity): Check header information of
+ `mime-view-situation' property.
+
+2000-02-09 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-preview-find-boundary-info): Use <last point>
+ - 1 instead of <last point> to get `mime-view-entity' property.
+
+ * 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
+ 'create-image)" to detect Emacs 21.
+ Use `eval-after-load' instead of `call-after-loaded' to require
+ `mime-image'.
+
+2000-02-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-view-define-keymap): Change keybind for
+ `mime-preview-toggle-header' to "\C-c\C-t\C-h".
+
+2000-02-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-image.el: Add checking for `x-face-mule'.
+
+ * pgg.el,pgp-gpg.el,pgg-pgp.el,pgg-pgp5.el
+ (pgg-scheme-lookup-key): Rename from
+ `pgg-scheme-lookup-key-string'.
+ (pgg-scheme-decrypt-region): Use `pgg-scheme-lookup-key'.
+ (pgg-scheme-sign-region): Ditto.
+
+ * pgg-gpg.el (pgg-scheme-lookup-key): Generate *PGG-output* buffer
+ if it does not exist.
+
+2000-01-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * semi-def.el (mime-user-interface-product): Bump up to
+ EMIKO 1.13.10.
+
+ * mime-image.el [Emacs21]: Require `image' when compiling.
+ (image-normalize): Use `create-image' with 3rd arg `data-p'.
+ (create-image): Advice it to accept 3rd arg `data-p'.
+
+ * pgg-pgp.el. pgg-pgp5.el
+ (pgg-scheme-verify-region): Don't send buffer contents.
+
+ * mime-pgp.el (mime-view-application/pkcs7-mime): Rename from
+ `mime-decrypt-application/pkcs7-mime'; handle `smime-type'
+ parameter; abolish local variable `representation-type'.
+
+ * semi-setup.el: Rename `mime-decrypt-application/pkcs7-mime' to
+ `mime-view-application/pkcs7-mime'.
+
+2000-01-18 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el,pgp-gpg.el,pgg-pgp.el,pgg-pgp5.el
+ (pgg-scheme-lookup-key-string,pgg-scheme-encrypt-region,
+ pgg-scheme-decrypt-region,pgg-scheme-sign-region,
+ pgg-scheme-verify-region,pgg-scheme-insert-key,
+ pgg-scheme-snarf-keys-region): Prepend `pgg-scheme' to each symbol.
+
+ * pgg.el
+ (pgg-encrypt-region,pgg-decrypt-region,pgg-sign-region,
+ pgg-verify-region,pgg-insert-key,pgg-snarf-keys-region,
+ pgg-lookup-key-string): Don't use `luna-send'.
+
+2000-01-17 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-view-entity-button-visible-p): Comment out.
+ (mime-display-entity): Don't use
+ `mime-view-entity-button-visible-p'.
+
+2000-01-17 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-find-entity-preview-situation): New function.
+ (mime-display-multipart/alternative): Use
+ `mime-find-entity-preview-situation'.
+ (mime-display-entity): Likewise; prefer`*entity-button' and
+ `*header'.
+ (mime-preview-toggle-header): Modify `*header' instead of
+ `header'; update `mime-preview-situation-example-list'.
+
+2000-01-17 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-unify-situations): Fixed.
+ (mime-view-define-keymap): Add new binding
+ `mime-preview-toggle-header' for C-c h.
+ (mime-preview-find-boundary-info): New function.
+ (mime-preview-follow-current-entity): Use
+ `mime-preview-find-boundary-info'.
+ (mime-preview-toggle-header): New command.
+
+2000-01-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-play.el (mime-play-entity): Modify for
+ `mime-unify-situations'.
+
+ * mime-view.el (mime-unify-situations): Add new optional argument
+ `required-name'; use it instead of `method'.
+ (mime-display-multipart/alternative): Use `mime-unify-situations'.
+ (mime-display-entity): Likewise.
+
+2000-01-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-reduce-situation-examples): New function;
+ delete `mime-reduce-acting-situation-examples'.
+
+2000-01-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-view.el (mime-view-find-every-situations): Renamed from
+ `mime-view-find-every-acting-situation'; changed to variable.
+ (mime-situation-examples-file): Renamed from
+ `mime-acting-situation-examples-file'.
+ (mime-preview-situation-example-list-max-size): New variable.
+ (mime-save-situation-examples): Renamed from
+ `mime-save-acting-situation-examples'; save
+ `mime-preview-situation-example-list' if it is not null.
+
+2000-01-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-play.el (mime-acting-situation-example-list): Moved to
+ mime-view.el.
+ (mime-acting-situation-example-list-max-size): Likewise.
+ (mime-save-acting-situation-examples): Likewise.
+ (mime-reduce-acting-situation-examples): Likewise.
+
+ * mime-view.el (mime-preview-situation-example-list): New
+ variable.
+ (mime-acting-situation-example-list): Moved from mime-play.el.
+ (mime-acting-situation-example-list-max-size): Likewise.
+ (mime-save-acting-situation-examples): Likewise.
+ (mime-reduce-acting-situation-examples): Likewise.
+ (mime-view-load-hook): Abolished.
+
+2000-01-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-play.el (mime-play-entity): Use `mime-unify-situations'.
+
+ * mime-view.el (mime-unify-situations): New function.
+
+2000-01-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-play.el (mime-compare-situation-with-example): Moved to
+ mime-view.el.
+ (mime-sort-situation): Likewise.
+
+ * mime-view.el (mime-compare-situation-with-example): Moved from
+ mime-play.el.
+ (mime-sort-situation): Likewise.
+
+2000-01-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * postpet.el: New module.
+
+ * SEMI-ELS (semi-modules-to-compile): Add `postpet'.
+
+ * mime-play.el (mime-delq-null-situation): Moved to mime-view.el.
+
+ * mime-view.el: Add setting for
+ `mime-display-application/x-postpet' to autoload "postpet".
+ (mime-delq-null-situation): Moved from mime-play.el.
+ (unpack): Moved to postpet.el.
+ (unpack-skip): Likewise.
+ (unpack-fixed): Likewise.
+ (unpack-byte): Likewise.
+ (unpack-short): Likewise.
+ (unpack-long): Likewise.
+ (unpack-string): Likewise.
+ (unpack-string-sjis): Likewise.
+ (postpet-decode): Likewise.
+ (mime-display-application/x-postpet): Likewise.
+
+2000-01-11 Nakagawa, Makoto <Makoto.Nakagawa@jp.compaq.com>
+
+ * pgg-pgp.el, pgg-pgp5.el
+ (pgg-scheme-lookup-key-string): Fix number of arguments against
+ call-process.
+
+ * pgg-pgp5.el (pgg-scheme-verify-region): Analize process output
+ to see whether verify successed or not.
+
+2000-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * Makefile, README.en: Update for the new CVS server.
+
+1999-12-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-user-agent-value): Don't require
+ `apel-ver' directly.
+
+1999-12-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-edit.el (mime-edit-user-agent-value): Use `error' instead of
+ `file-error' for the handler of `condition-case' because XEmacs
+ does not signal an error named `file-error' if the required feature
+ is not provided.
+
+1999-12-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * semi-setup.el (mime-setup-decode-message-header): Comment out.
+ (mime-edit-mode-hook): Don't use
+ `mime-setup-decode-message-header'.
+ (mu-cite/pre-cite-hook): Don't use `eword-decode-header'.
+
+1999-12-14 Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+
+ * mime-view.el (mime-preview-follow-current-entity): Fetch field of
+ `mime-view-following-required-fields-list' from parent entity if it
+ is not exist in current entity.
+
+1999-12-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * README.en: Update for the recent ML address and ftp site.
+
+1999-12-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * smime.el (smime-encrypt-region): Delete entity header.
+ (smime-sign-region): Ditto.
+
+ * mime-edit.el: Fix autoload settings for `smime-sign-region' and
+ `smime-encrypt-region.
+ (mime-edit-sign-smime): Set Content-Type
+ `application/pkcs7-signature' instead of
+ `application/x-pkcs7-signature'; add Content-Description.
+ (mime-edit-encrypt-smime): Set content-type
+ `application/pkcs7-mime' instead of `x-application/pkcs7-mime'.
+
+ * mime-pgp.el: Fix autoload settings for `smime-verify-region' and
+ `smime-decrypt-region.
+ (mime-decrypt-application/pkcs7-mime):
+ Bind `inhibit-read-only' to t.
+
+1999-12-09 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * semi-def.el (mime-user-interface-product): Bump up to
+ EMIKO 1.13.9.
+
+ * smime.el: Require `static' when compiling.
+ (smime-directory-files): New macro.
+ (smime-find-certificate): Use it.
+
+1999-12-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * smime.el (smime-verify-region): Abolish local variable `cert-file'.
+ (smime-find-certificate): Rename from `smime-search-certificate'.
+
+ * mime-edit.el: Add autoload settings for `smime-encrypt-region' and
+ `smime-sign-region'.
+ (mime-edit-process-multipart-1): Handle type "smime-signed" and
+ "smime-encrypted".
+ (mime-edit-sign-smime): New function.
+ (mime-edit-encrypt-smime): New function.
+ (mime-edit-enclose-smime-signed-region): New function.
+ (mime-edit-enclose-smime-encrypted-region): New function.
+
+ * mime-pgp.el: Add autoload settings for `smime-decrypt-region' and
+ `smime-verify-region'.
+ (mime-verify-application/pkcs7-signature): New function.
+ (mime-decrypt-application/pkcs7-mime): New function.
+
+ * semi-setup.el: Set up for `mime-verify-application/pkcs7-signature'
+ and `mime-decrypt-application/pkcs7-mime'.
+
+1999-12-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * smime.el (smime-x509-hash): Use `call-process' instead of
+ `call-process-region'.
+ (smime-x509-subject): Ditto.
+
+1999-12-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * SEMI-ELS (semi-modules-to-compile): Add smime.el.
+
+ * smime.el: New file.
+
+1999-11-30 Tsukamoto Tetsuo <czkmt@remus.dti.ne.jp>
+
+ * mime-edit.el (mime-edit-decode-message-in-buffer): Don't decode
+ the message header twice.
+
+1999-11-30 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-remove-passphrase-cache): Add checking whether
+ the passphrase has already been expired.
+
+1999-11-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-pgp-user-id): New variable.
+ (mime-edit-sign-pgp-mime): Undo last change; refer
+ `mime-edit-pgp-user-id'.
+ (mime-edit-encrypt-pgp-mime): Ditto.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el
+ (encrypt-region): Refer `pgg-<impl>-user-id' if specified.
+ (sign-region): Ditto.
+ (decrypt-region): Ditto.
+ (insert-key): Ditto.
+
+1999-11-26 Nakagawa, Makoto <Makoto.Nakagawa@jp.compaq.com>
+
+ * mime-edit.el (mime-edit-sign-pgp-mime): Regard
+ `pgg-default-user-id' as more preferrable if it's specified.
+ (mime-edit-encrypt-pgp-mime): Ditto.
+
+1999-11-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * semi-def.el (mime-user-interface-product): Bump up to
+ EMIKO 1.13.8.
+
+ * pgg.el (pgg-remove-passphrase-cache): Don't unbind passphrase.
+
+1999-11-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-sign-pgp-mime): Bind
+ `pgg-default-user-id' to the canonical address of From field.
+
+ * pgg-def.el (pgg-cache-passphrase): New user option.
+
+ * pgg.el (pgg-read-passphrase): Refer `pgg-cache-passphrase'.
+ (pgg-remove-passphrase-cache): Fill cached passphrase with `_'.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (sign-region): Refer
+ `pgg-cache-passphrase'.
+
+1999-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-image.el (mime-display-image): Use
+ `mime-image-normalize-xbm' if the feature `xemacs' is provided or
+ the variable `image-types' is bound.
+
+1999-11-17 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-image.el (mime-image-normalize-xbm): Work for the future
+ FSF Emacsen as well.
+ (mime-display-image): Always use `mime-image-normalize-xbm'.
+
+1999-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-image.el (mime-image-normalize-xbm): New macro.
+ (mime-display-image): Use it.
+
+1999-11-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-temp-buffer-show-function): New function.
+ (pgg-display-output-buffer): Use it.
+ (pgg-save-coding-system): Use buffer narrowing.
+ (pgg-encrypt-region, pgg-decrypt-region, pgg-sign-region,
+ pgg-verify-region): Assume that the current region has already
+ been narrowed.
+
+1999-11-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-def.el (pgg-default-keyserver-address): Default to
+ `wwwkeys.pgp.net'.
+
+ * pgg.el (pgg-save-coding-system): New macro.
+ (pgg-display-output-buffer): New function.
+ (pgg-encrypt-region, pgg-decrypt-region, pgg-sign-region,
+ pgg-verify-region, pgg-insert-key, pgg-snarf-keys-region):
+ Add documentation string; use `pgg-save-coding-system'.
+ (pgg-fetch-key): Fix documentation.
+
+1999-11-11 Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+
+ * mime-image.el (image-normalize): Use `write-region-as-binary'.
+
+1999-11-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-pgp.el, pgg-pgp5.el (verify-region): Set default umask to 077.
+
+1999-11-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-gpg.el (pgg-gpg-process-region): Enclose `start-process'
+ with `as-binary-process'.
+
+ * pgg-pgp.el (pgg-pgp-process-region): Enclose `start-process'
+ with `as-binary-process'.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Enclose `start-process'
+ with `as-binary-process'.
+
+ * mime-edit.el (mime-edit-set-sign): Remove duplication.
+ (mime-edit-set-encrypt): Ditto.
+ (mime-edit-encrypt-pgp-mime): Encode header before encrypting.
+
+ * mime-image.el (image-insert-at-point): Check the number of the
+ arguments of `insert-image'.
+ (mime-display-image): Rewrite.
+
+1999-11-10 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+
+ * mime-play.el: (mime-save-directory): New variable.
+ (mime-save-content): Don't force filename parameter to be used.
+
+1999-11-09 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-pgp.el, pgg-pgp5.el
+ (sign-region): Don't convert line break code.
+
+1999-11-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-verify-application/pgp-signature): Don't
+ scroll MIME-echo buffer, just set window starting point.
+ (mime-add-application/pgp-keys): Ditto.
+
+1999-11-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-sign-region): Add optional argument `cleartext'.
+
+ * mime-ui-en.sgml, mime-ui-ja.sgml: Remove description about
+ `pgp-functions-alist' and `pgp-function'; add description about
+ `pgg-default-scheme' and `pgg-scheme'.
+
+ * NEWS (PGP 5.0i and GnuPG are now supported for PGP/MIME):
+ New section.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (encrypt-region): Add
+ sender's user id to the recipients list if `pgg-encrypt-for-me' is
+ specified.
+
+ * pgg-def.el (pgg-encrypt-for-me): New user option.
+
+ * mime-edit.el:
+ (mime-edit-decode-multipart-in-buffer): Sync up with semi-pgpgpg_20.
+ (mime-edit-decode-message-in-buffer): Ditto.
+ (mime-edit-decode-single-part-in-buffer): Ditto.
+
+1999-11-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-verify-region): Bind `pgg-scheme' in the predicate
+ of whether to fetch signer's public key.
+ (pgg-convert-lbt-region): New macro.
+ (pgg-as-lbt): New macro.
+
+ * mime-edit.el (mime-edit-encrypt-pgp-mime): Extract canonical
+ address of From field to use it as default user id; tokenize
+ bodies of the recipient fields.
+ (mime-edit-make-encrypt-recipient-header): Undo last change.
+ (mime-edit-translate-buffer): Do `undo-boundary'
+ before translating.
+
+ * pgg-gpg.el (sign-region): Use `pgg-as-lbt'.
+ (pgg-gpg-process-region): Use `pgg-convert-lbt-region'.
+ (encrypt-region): Don't ask passphrase.
+
+ * pgg-pgp5.el (sign-region): Use `pgg-as-lbt'.
+ (pgg-pgp5-process-region): Use `pgg-convert-lbt-region'.
+ (encrypt-region): Don't ask passphrase.
+
+ * pgg-pgp.el (verify-region): Fill errors buffer.
+ (pgg-pgp-process-region): Use `pgg-convert-lbt-region'.
+ (sign-region): Use `pgg-as-lbt'.
+ (encrypt-region): Don't ask passphrase.
+
+1999-11-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el (pgg-byte-after): Always pass the first argument
+ of `char-after'.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-pgp.el (sign-region): Fix regexp for the beginning of armor.
+
+ * pgg-gpg.el (encrypt-region): Don't use "--textmode" in GPG
+ arguments, replace line break code with CRLF while signing
+ instead.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-verify-application/pgp-signature): Copy the
+ messages in PGG buffers to MIME-echo buffer instead of binding
+ `pgg-output-buffer'.
+ (mime-add-application/pgp-keys): Likewise.
+
+ * pgg-gpg.el (verify-region): Fill errors buffer whether
+ verification has succeeded or not.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (snarf-keys-region):
+ Use `pgg-process-when-success'.
+
+ * pgg.el (pgg-encrypt-region): Add autoload cookie.
+ (pgg-decrypt-region): Ditto.
+ (pgg-sign-region): Ditto.
+ (pgg-verify-region): Don't modify the buffer; add autload cookie.
+ (pgg-snarf-keys-region): Add interactive spec; add autload cookie.
+ (pgg-insert-key): Add interactive spec; add autload cookie.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-gpg.el (pgg-gpg-shell-command-switch): New user option.
+ (pgg-gpg-process-region): Bind `shell-command-switch' to the value
+ of `pgg-gpg-shell-command-switch'.
+
+ * pgg-pgp.el (pgg-pgp-shell-command-switch): New user option.
+ (pgg-pgp-process-region): Bind `shell-command-switch' to the value
+ of `pgg-pgp-shell-command-switch'.
+
+ * pgg-pgp5.el (pgg-pgp5-shell-command-switch): New user option.
+ (pgg-pgp5-process-region): Bind `shell-command-switch' to the value
+ of `pgg-pgp5-shell-command-switch'.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (sign-region): Use fixed end
+ position of the signature.
+
+ * mime-pgp.el: Add autoload for `pgg-decrypt-region',
+ `pgg-verify-region', `pgg-snarf-keys-region'.
+ (mime-view-application/pgp): Don't use `pgp-function'.
+ (mime-verify-application/pgp-signature): Ditto.
+ (mime-add-application/pgp-keys): Ditto.
+ (mime-pgp-command): Abolish.
+ (mime-pgp-default-language): Abolish.
+ (mime-pgp-good-signature-regexp-alist): Abolish.
+ (mime-pgp-key-expected-regexp-alist): Abolish
+ (mime-pgp-check-signature): Abolish.
+
+ * semi-def.el (pgp-function-alist): Abolish.
+ (pgp-function): Abolish.
+
+ * mime-edit.el: Add autoload for `pgg-encrypt-region',
+ `pgg-sign-region', `pgg-insert-key'.
+ (mime-edit-sign-pgp-mime): Throw an error when
+ `pgg-sign-region' returns nil; don't use `pgp-function'.
+ (mime-edit-encrypt-pgp-mime): Throw an error when
+ `pgg-encrypt-region' returns nil; don't use `pgp-function'.
+ (mime-edit-sign-pgp-kazu): Don't use `pgp-function'.
+ (mime-edit-encrypt-pgp-mime): Ditto.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-add-application/pgp-keys): Don't display
+ public key block; snarf keys immediately.
+
+ * pgg.el (pgg-insert-url-with-program): Call program asynchronously.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-def.el (pgg-echo-buffer): New variable.
+
+ * pgg.el (pgg-process-when-success): New macro.
+ (pgg-insert-url-with-w3): New function.
+ (pgg-insert-url-program): New variable.
+ (pgg-insert-url-extra-arguments): New variable.
+ (pgg-insert-url-function): New variable.
+ (pgg-fetch-key): Use it.
+ (pgg-encrypt-region): If called interactively, popup
+ `pgg-echo-buffer' to display encryption status.
+ (pgg-decrypt-region): Likewise.
+ (pgg-sign-region): Likewise.
+ (pgg-verify-region): Likewise.
+
+ * pgg-gpg.el (lookup-key-string): Use `call-process' instead of
+ `pgg-gpg-process-region'.
+ (encrypt-region): Use `pgg-process-when-success'; if the output
+ buffer is empty, don't copy errors, just return nil.
+ (decrypt-region): Likewise.
+ (verify-region): Check the contents of status buffer to looking
+ for `GOODSIG' response.
+ (sign-region): Accept optional argument `clearsign'.
+
+ * pgg-pgp.el (lookup-key-string): Use `call-process' instead of
+ `pgg-pgp-process-region'.
+ (encrypt-region): Use `pgg-process-when-success'; if the output
+ buffer is empty, don't copy errors, just return nil.
+ (decrypt-region): Likewise.
+ (verify-region): Likewise.
+ (sign-region): Accept optional argument `clearsign'.
+
+ * pgg-pgp5.el (lookup-key-string): Use `call-process' instead of
+ `pgg-pgp5-process-region'.
+ (encrypt-region): Use `pgg-process-when-success'; if the output
+ buffer is empty, don't copy errors, just return nil.
+ (decrypt-region): Likewise.
+ (verify-region): Likewise.
+ (sign-region): Accept optional argument `clearsign'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-verify-region): Ignore all errors encountered on
+ calling `pgg-fetch-key'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-verify-application/pgp-signature): Enclose
+ with `unwind-protect' to be sure of deleting *.asc files.
+
+ * pgg-pgp.el (pgg-pgp-process-region): Set `PGPPASSFD' before
+ starting PGP process.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el (pgg-parse-crc24): Don't use any `write' ops.
+ (pgg-parse-crc24-string): Use `ccl-execute-on-string'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-set-sign): Preserve last status of
+ `mime-edit-pgp-processing'.
+ (mime-edit-set-encrypt): Ditto.
+ (mime-edit-pgp-enclose-buffer): Process
+ `mime-edit-pgp-enclose-buffer' consequently.
+
+ * pgg-parse.el (pgg-decode-packets): Don't use
+ `mime-encode-string'.
+ (pgg-ignore-packet-checksum): Default to t.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el: Rename the field name `cipher-algorithm' to
+ `symmetric-key-algorithm'.
+ (pgg-verify-condition): Fix documentation.
+ (pgg-decrypt-condition): Ditto.
+
+1999-11-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-edit.el (mime-edit-preview-message): Inherit the value of
+ `mime-edit-pgp-processing'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-encrypt-region): Add interactive spec.
+ (pgg-decrypt-region): Ditto.
+ (pgg-sign-region): Ditto.
+ (pgg-verify-region): Add optional argument `fetch' to fetch
+ signer's public key.
+
+ * pgg-def.el (pgg-default-keyserver-address): New variable.
+
+ * semi-def.el (pgp-function-alist): Remove `lookup-key'.
+
+ * mime-pgp.el (mime-display-application/pgp-signature): Abolish.
+ (mime-display-application/pgp-encrypted): Abolish.
+ (mime-display-application/pgp-keys): Abolish.
+ (mime-pgp-keyserver-url-template): Abolish.
+ (mime-pgp-keyserver-address): Abolish.
+ (mime-pgp-keyserver-port): Abolish.
+ (mime-pgp-keyserver-protocol): Abolish.
+ (mime-pgp-fetch-key): Abolish.
+
+ * semi-setup.el: Delete default setting of
+ `mime-display-application/pgp-signature',
+ `mime-display-application/pgp-encrypted',
+ `mime-display-application/pgp-keys'
+
+1999-11-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-fetch-key): Protect `buffer-file-name'.
+
+ * pgg-gpg.el (snarf-keys-region): Add `-' as extra argument of
+ gpg --import; convert status code into an integer.
+
+1999-11-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * semi-def.el (pgp-function-alist): Add `lookup-key'.
+
+ * pgg.el, pgg-gpg.el, pgg-pgp5.el, pgg-pgp.el:
+ Rename generic function `lookup-key' to `lookup-key-string';
+ add optional argument `type'.
+
+ * pgg-def.el (pgg-truncate-key-identifier): New macro.
+
+ * pgg.el: Rename generic function `lookup-key' to
+ `lookup-key-string'; add optional argument `type'.
+ (pgg-fetch-key): New function.
+ (pgg-snarf-keys-region): Fix typo.
+ (pgg-lookup-key-string): New function.
+ (pgg-read-passphrase): Use `pgg-truncate-key-identifier'.
+ (pgg-add-passphrase-cache): Ditto.
+
+ * mime-pgp.el (mime-pgp-keyserver-url-template): New variable
+ imported from semi-pgpgpg.
+ (mime-pgp-keyserver-address): Ditto.
+ (mime-pgp-keyserver-port): Ditto.
+ (mime-pgp-keyserver-protocol): New variable.
+ (mime-pgp-fetch-key): New function.
+ (mime-verify-application/pgp-signature): Prompt user to fetch
+ signer's public key.
+
+1999-11-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-fetch-public-key): New function.
+
+ * pgg-pgp.el (lookup-key): New generic function.
+ (encrypt-region): Use `lookup-key'; cache passphrase if the
+ encryption has done successfully.
+ (sign-region): Likewise.
+ (decrypt-region): Use `lookup-key'.
+
+ * pgg.el (pgg-scheme): Remove all slots.
+ (pgg-decrypt-codition): Rename tag `cipher-algorithm' to
+ `symmetric-key-algorithm'.
+ (lookup-key): Add documentation about the new generic function.
+
+ * pgg-parse.el (pgg-decode-armor-region): Remove autoload cookie.
+ (pgg-armor-header-lines): New variable.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-add-passphrase-cache): Use only four octets of the key.
+ (pgg-read-passphrase): Ditto.
+
+ * pgg-pgp5.el (lookup-key): New generic function.
+ (encrypt-region): Use `lookup-key'; cache passphrase if the
+ encryption has done successfully.
+ (sign-region): Likewise.
+ (decrypt-region): Use `lookup-key'.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el
+ (pgg-parse-public-key-encrypted-session-key-packet):
+ Rename tag `public-key-identifier' to `key-identifier'.
+
+ * mime-pgp.el
+ (mime-display-application/pgp-encrypted): Refer it.
+
+ * pgg.el (pgg-passphrase-cache-expiry): New variable.
+ (pgg-passphrase-cache): New variable.
+ (pgg-read-passphrase): Add optional argument `key'.
+ (pgg-add-passphrase-cache): New function.
+ (pgg-remove-passphrase-cache): New function.
+
+ * pgg-gpg.el (lookup-key): New generic function.
+ (encrypt-region): Use `lookup-key'; cache passphrase if the
+ encryption has done successfully.
+ (sign-region): Likewise.
+ (decrypt-region): Use `lookup-key'.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el (pgg-parse-length-type): Fix typo.
+ (pgg-parse-public-key-encrypted-session-key-packet): Use
+ `pgg-read-bytes-string' instead of `pgg-read-bytes'.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-sign-pgp-mime): Rewrite with PGG functions.
+ (mime-edit-encrypt-pgp-mime): Likewise.
+ (mime-edit-encrypt-recipient-fields-list): Return recipients as list.
+
+ * mime-pgp.el: Add comment that this module is based on
+ draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) and RFC 2440
+ (OpenPGP Message Format) as well.
+ (mime-verify-application/pgp-signature): Use
+ `pgg-verify-region' instead of `mime-pgp-check-signature'.
+ (mime-display-application/pgp-signature): New function.
+ (mime-display-application/pgp-encrypted): New function.
+ (mime-display-application/pgp-keys): New function.
+
+ * semi-setup.el: Set up for
+ `mime-display-application/pgp-signature',
+ `mime-display-application/pgp-encrypted',
+ `mime-display-application/pgp-keys'.
+ (mime-setup-enable-pgp): Default to t.
+
+ * SEMI-ELS (semi-modules-to-compile): Add `pgg', `pgg-parse',
+ `pgg-gpg', `pgg-pgp' and `pgg-pgp5' instead of `mime-mc'.
+
+ * EMIKO-VERSION, pgg-def.el, pgg.el, pgg-gpg.el,
+ pgg-pgp5.el, pgg-pgp.el, pgg-parse.el: New file.
+
+ * mime-image.el (mime-display-image): Rewrite.
+
+ * semi-def.el (mime-user-interface-product): Modify for EMIKO.
+ (pgp-function-alist): Replace each method with PGG function.
+
+ * mime-view.el (mime-view-popup-menu): New variable.
+ (mime-view-popup-menu): New function.
+ (mime-view-define-keymap): Bind `mime-view-popup-menu' to
+ `mouse-button-3'.
+
+1999-11-01 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mime-view.el (mime-display-application/x-postpet): New function.
+ (mime-preview-condition): Set up for
+ 'mime-preview-application/x-postpet.
+ (unpack): New macro.
+ (unpack-skip): New function.
+ (unpack-fixed): New function.
+ (unpack-byte): New function.
+ (unpack-short): New function.
+ (unpack-long): New function.
+ (unpack-string): New function.
+ (unpack-string-sjis): New function.
+ (postpet-decode): New function.
+
+1999-10-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+
+ * SEMI-MK (install-semi-package): Delte auto-autoloads.el
+ and custom-load.el
+
+\f
1999-10-16 MORIOKA Tomohiko <tomo@m17n.org>
* SEMI: Version 1.13.7 (Awazu) released.
# Makefile for SEMI kernel.
#
-PACKAGE = semi
-API = 1.13
-RELEASE = 7
+PACKAGE = remi
+API = 1.14
+RELEASE = 2
-FLIM_API= 1.13
+FLIM_API= 1.14
TAR = tar
RM = /bin/rm -f
GOMI = *.elc
VERSION = $(API).$(RELEASE)
-ARC_DIR = /pub/mule/semi/semi-$(API)-for-flim-$(FLIM_API)
+ARC_DIR = /home/tomo/public_html/comp/emacsen/lisp/semi/semi-$(API)-for-flim-$(FLIM_API)
elc:
cvs commit
sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) | tr . _`; \
cd /tmp; \
- cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \
+ cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \
export -d $(PACKAGE)-$(VERSION) \
-r $(PACKAGE)-`echo $(VERSION) | tr . _` \
semi'
* Changes in SEMI 1.13
+** PGP 5.0i and GnuPG are now supported for PGP/MIME
+
+ You can select the various PGP or GnuPG commands by the user option
+`pgg-default-scheme' or `pgg-scheme'. The former is for encrypting and
+signing, the latter could be bound for controlling which command is
+used to process the incoming PGP armors. Note that Mailcrypt is not
+needed anymore. A user interface for editing or viewing has never
+changed. Note also that `pgp-function' and `pgp-functions-alist' are
+abolished in this version.
+
+
** Requires FLIM 1.13 API
19.14. SEMI also does not support Emacs 19.29 to 19.34, XEmacs
19.15 or XEmacs 20.2 without mule, but SEMI may work with them.
- SEMI requires APEL (9.20 or later) and FLIM (1.13.1 or later)
+ SEMI requires APEL (9.22 or later) and FLIM (Chao 1.14.1 or later)
package. Please install them before installing it. APEL package is
available at:
- ftp://ftp.etl.go.jp/pub/mule/apel/
+ ftp://ftp.m17n.org/pub/mule/apel/
and FLIM package is available at:
- ftp://ftp.etl.go.jp/pub/mule/flim/flim-1.13/
+ http://www.kanji.zinbun.kyoto-u.ac.jp/~tomo/comp/emacsen/lisp/
+ flim/flim-1.14/
PGP/MIME and application/pgp require mailcrypt or tiny-pgp package.
=============
If you write bug-reports and/or suggestions for improvement, please
- send them to the tm Mailing List:
+ send them to the EMACS-MIME Mailing List:
- bug-tm-en@chamonix.jaist.ac.jp (English)
- bug-tm-ja@chamonix.jaist.ac.jp (Japanese)
+ emacs-mime-en@m17n.org (English)
+ emacs-mime-ja@m17n.org (Japanese)
- Via the tm ML, you can report SEMI bugs, obtain the latest release
- of SEMI, and discuss future enhancements to SEMI. To join the tm
- ML, send an empty e-mail to
+ Via the EMACS-MIME ML, you can report SEMI bugs, obtain the latest
+ release of SEMI, and discuss future enhancements to SEMI. To join
+ the EMACS-MIME ML, send an empty e-mail to
- tm-en-help@chamonix.jaist.ac.jp (English)
- tm-ja-help@chamonix.jaist.ac.jp (Japanese)
+ emacs-mime-en-ctl@m17n.org (English)
+ emacs-mime-ja-ctl@m17n.org (Japanese)
Notice that you should not send mail to author(s), such as
morioka@jaist.ac.jp, directly. Because your problem may occur in
other environments (if not, it might be your problem, not bug of
- SEMI). We should discuss in the tm mailing lists. Anyway
+ SEMI). We should discuss in the EMACS-MIME mailing lists. Anyway
direct-mail for authors might be ignored. Please send mail to the
- tm mailing lists.
+ EMACS-MIME mailing lists.
CVS based development
If you would like to join CVS based development, please send mail to
- cvs@chamonix.jaist.ac.jp
+ cvs@cvs.m17n.org
- with your account name and UNIX style crypted password. We hope you
- will join the open development.
+ with your account name and your public key for ssh. cvsroot is
+ :ext:cvs@cvs.m17n.org:/cvs/root.
+
+ If you cannot use ssh, please send UNIX /etc/passwd style crypted
+ password. you can commit with the cvsroot
+ :pserver:<accountname>@cvs.m17n.org:/cvs/root.
+
+ We hope you will join the open development.
Authors
(setq semi-modules-to-compile
'(signature
- semi-def mime-view mime-play mime-partial mime-edit
+ pgg-def pgg pgg-parse pgg-gpg pgg-pgp5 pgg-pgp mime-pgp
+ smime
+ semi-def mime-view mime-play mime-partial postpet
+ mime-edit
semi-setup mail-mime-setup))
(setq semi-modules-not-to-compile nil)
(nconc semi-modules-not-to-compile i-modules))
)
)))
- '((mailcrypt mime-pgp mime-mc)
- (bbdb mime-bbdb)
+ '((bbdb mime-bbdb)
(w3 mime-w3)
))
(expand-file-name SEMI_PREFIX
(expand-file-name "lisp"
PACKAGEDIR)))
+ (delete-file "./auto-autoloads.el")
+ (delete-file "./custom-load.el")
)
;;; SEMI-MK ends here
------- Kawake \e$(B2OLS\e(B
------- Torahime \e$(B8WI1\e(B
------- Nagahama \e$(BD9IM\e(B
-------- Tamura \e$(BEDB<\e(B
+------- Tamura \e$(BEDB<\e(B
------- Sakata \e$(B:dED\e(B
(Maibara) (\e$(BJF86\e(B) ; = JR \e$(BEl3$F;K\@~\e(B
1.13.0 Saigata \e$(B:T3c\e(B ; = JR \e$(B?.1[K\@~\e(B
1.13.1 Kubiki \e$(B$/$S$-\e(B
1.13.2 \e-DÒike-Ikoinomori\e-A \e$(BBgCS$$$3$$$N?9\e(B
+1.14.0 Uragawara \e$(B$&$i$,$o$i\e(B
+1.14.1 Mushigawa\e-Dòsugi\e-A \e$(BCn@nBg?y\e(B
+1.14.2 Hokuhoku-\e-DÒshima\e-A \e$(B$[$/$[$/BgEg\e(B
+1.14.3 Matsudai \e$(B$^$D$@$$\e(B
[etc.]
It is available from
- ftp://ftp.m17n.org/pub/mule/semi/semi-API-for-flim-FLIM_API
+ http://www.kanji.zinbun.kyoto-u.ac.jp/~tomo/comp/emacsen/lisp/semi/semi-API-for-flim-FLIM_API/
-or
-
- ftp://ftp.etl.go.jp/pub/mule/semi/semi-API-for-flim-FLIM_API
-
---[[message/external-body;
- access-type=anon-ftp;
- site="ftp.m17n.org";
- directory="/pub/mule/semi/semi-API-for-flim-FLIM_API";
- name="PACKAGE-VERSION.tar.gz";
- mode=image]]
+--[[message/external-body; access-type=URL;
+ URL*0="http://";
+ URL*1="www.kanji.zinbun.kyoto-u.ac.jp/~tomo/";
+ URL*2="comp/emacsen/lisp/";
+ URL*3="semi/semi-API-for-flim-FLIM_API/";
+ URL*4="PACKAGE-VERSION.tar.gz"]]
Content-Type: application/octet-stream;
name="PACKAGE-VERSION.tar.gz";
type=tar;
;;; mime-edit.el --- Simple MIME Composer for GNU Emacs
-;; Copyright (C) 1993,94,95,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1993,94,95,96,97,98,99,2000 Free Software Foundation, Inc.
;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
;; Created: 1994/08/21 renamed from mime.el
;; Renamed: 1997/2/21 from tm-edit.el
;; Keywords: MIME, multimedia, multilingual, mail, news
(require 'signature)
(require 'alist)
(require 'invisible)
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(autoload 'pgg-encrypt-region "pgg"
+ "PGP encryption of current region." t)
+(autoload 'pgg-sign-region "pgg"
+ "PGP signature of current region." t)
+(autoload 'pgg-insert-key "pgg"
+ "Insert PGP public key at point." t)
+(autoload 'smime-encrypt-region "smime"
+ "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
;; Octect binary text
("\\.doc$" ;MS Word
- "application" "winword" nil
+ "application" "msword" nil
"base64"
"attachment" (("filename" . file))
)
(iso-8859-8 8 "quoted-printable")
(iso-8859-9 8 "quoted-printable")
(iso-2022-jp 7 "base64")
+ (iso-2022-jp-3 7 "base64")
(iso-2022-kr 7 "base64")
(euc-kr 8 "base64")
(cn-gb 8 "base64")
"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-product-code-name mime-library-product)
") "
+ (if (fboundp 'apel-version)
+ (concat (apel-version) " "))
(if (featurep 'xemacs)
(concat (cond ((featurep 'utf-2000)
(concat "UTF-2000-MULE/" utf-2000-version))
(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)))
))))
(defun mime-edit-translate-buffer ()
"Encode the tagged MIME message in current buffer in MIME compliant message."
(interactive)
+ (undo-boundary)
(if (catch 'mime-edit-error
(save-excursion
(run-hooks 'mime-edit-translate-buffer-hook)
((string-equal type "kazu-encrypted")
(mime-edit-encrypt-pgp-kazu bb eb boundary)
)
+ ((string-equal type "smime-signed")
+ (mime-edit-sign-smime bb eb boundary)
+ )
+ ((string-equal type "smime-encrypted")
+ (mime-edit-encrypt-smime bb eb boundary)
+ )
(t
(setq boundary
(nth 2 (mime-edit-translate-region bb eb
(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
- (narrow-to-region beg end)
- (let* ((ret
- (mime-edit-translate-region beg end boundary))
+ (let* ((from (std11-field-body "From" mail-header-separator))
+ (ret (progn
+ (narrow-to-region beg end)
+ (mime-edit-translate-region beg end boundary)))
(ctype (car ret))
(encoding (nth 1 ret))
- (pgp-boundary (concat "pgp-sign-" boundary)))
+ (pgp-boundary (concat "pgp-sign-" boundary))
+ micalg)
(goto-char beg)
(insert (format "Content-Type: %s\n" ctype))
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding))
)
(insert "\n")
- (or (as-binary-process
- (funcall (pgp-function 'mime-sign)
- (point-min)(point-max) nil nil pgp-boundary))
+ (or (let ((pgg-default-user-id
+ (or mime-edit-pgp-user-id
+ (if from
+ (nth 1 (std11-extract-address-components from))
+ pgg-default-user-id))))
+ (pgg-sign-region (point-min)(point-max)))
(throw 'mime-edit-error 'pgp-error)
)
+ (setq micalg
+ (cdr (assq 'hash-algorithm
+ (cdar (with-current-buffer pgg-output-buffer
+ (pgg-parse-armor-region
+ (point-min)(point-max))))))
+ micalg
+ (if micalg
+ (concat "; micalg=pgp-" (downcase (symbol-name micalg)))
+ ""))
+ (goto-char beg)
+ (insert (format "--[[multipart/signed;
+ boundary=\"%s\"%s;
+ protocol=\"application/pgp-signature\"][7bit]]
+--%s
+" pgp-boundary micalg pgp-boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s
+Content-Type: application/pgp-signature
+Content-Transfer-Encoding: 7bit
+
+" pgp-boundary))
+ (insert-buffer-substring pgg-output-buffer)
+ (goto-char (point-max))
+ (insert (format "\n--%s--\n" pgp-boundary))
))))
(defvar mime-edit-encrypt-recipient-fields-list '("To" "cc"))
(save-excursion
(save-restriction
(let (from recipients header)
- (let ((ret (mime-edit-make-encrypt-recipient-header)))
- (setq from (aref ret 0)
- recipients (aref ret 1)
- header (aref ret 2))
+ (let ((ret (mime-edit-make-encrypt-recipient-header)))
+ (setq from (aref ret 0)
+ recipients (aref ret 1)
+ header (aref ret 2))
)
- (narrow-to-region beg end)
- (let* ((ret
- (mime-edit-translate-region beg end boundary))
- (ctype (car ret))
- (encoding (nth 1 ret))
- (pgp-boundary (concat "pgp-" boundary)))
- (goto-char beg)
- (insert header)
- (insert (format "Content-Type: %s\n" ctype))
- (if encoding
- (insert (format "Content-Transfer-Encoding: %s\n" encoding))
- )
- (insert "\n")
- (or (funcall (pgp-function 'encrypt)
- recipients (point-min) (point-max) from)
+ (narrow-to-region beg end)
+ (let* ((ret
+ (mime-edit-translate-region beg end boundary))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (pgp-boundary (concat "pgp-" boundary)))
+ (goto-char beg)
+ (insert header)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (eword-encode-header)
+ (or (let ((pgg-default-user-id
+ (or mime-edit-pgp-user-id
+ (if from
+ (nth 1 (std11-extract-address-components from))
+ pgg-default-user-id))))
+ (pgg-encrypt-region
+ (point-min) (point-max)
+ (mapcar (lambda (recipient)
+ (nth 1 (std11-extract-address-components
+ recipient)))
+ (split-string recipients
+ "\\([ \t\n]*,[ \t\n]*\\)+")))
+ )
(throw 'mime-edit-error 'pgp-error)
)
+ (delete-region (point-min)(point-max))
(goto-char beg)
(insert (format "--[[multipart/encrypted;
boundary=\"%s\";
Content-Transfer-Encoding: 7bit
" pgp-boundary pgp-boundary pgp-boundary))
+ (insert-buffer-substring pgg-output-buffer)
(goto-char (point-max))
(insert (format "\n--%s--\n" pgp-boundary))
)))))
(insert (format "Content-Transfer-Encoding: %s\n" encoding))
)
(insert "\n")
- (or (as-binary-process
- (funcall (pgp-function 'traditional-sign)
- beg (point-max)))
+ (or (pgg-sign-region beg (point-max) 'clearsign)
(throw 'mime-edit-error 'pgp-error)
)
(goto-char beg)
(insert (format "Content-Transfer-Encoding: %s\n" encoding))
)
(insert "\n")
- (or (as-binary-process
- (funcall (pgp-function 'encrypt)
- recipients beg (point-max) nil 'maybe)
- )
+ (or (pgg-encrypt-region beg (point-max) recipients)
(throw 'mime-edit-error 'pgp-error)
)
(goto-char beg)
))
)))
+(defun mime-edit-sign-smime (beg end boundary)
+ (save-excursion
+ (save-restriction
+ (let* ((ret (progn
+ (narrow-to-region beg end)
+ (mime-edit-translate-region beg end boundary)))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (smime-boundary (concat "smime-sign-" boundary)))
+ (goto-char beg)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (let (buffer-undo-list)
+ (goto-char (point-min))
+ (while (progn (end-of-line) (not (eobp)))
+ (insert "\r")
+ (forward-line 1))
+ (or (prog1 (smime-sign-region (point-min)(point-max))
+ (push nil buffer-undo-list)
+ (ignore-errors (undo)))
+ (throw 'mime-edit-error 'pgp-error)
+ ))
+ (goto-char beg)
+ (insert (format "--[[multipart/signed;
+ boundary=\"%s\"; micalg=sha1;
+ protocol=\"application/pkcs7-signature\"][7bit]]
+--%s
+" smime-boundary smime-boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s
+Content-Type: application/pkcs7-signature; name=\"smime.p7s\"
+Content-Transfer-Encoding: base64
+Content-Disposition: attachment; filename=\"smime.p7s\"
+Content-Description: S/MIME Cryptographic Signature
+
+" smime-boundary))
+ (insert-buffer-substring smime-output-buffer)
+ (goto-char (point-max))
+ (insert (format "\n--%s--\n" smime-boundary))
+ ))))
+
+(defun mime-edit-encrypt-smime (beg end boundary)
+ (save-excursion
+ (save-restriction
+ (let* ((ret (progn
+ (narrow-to-region beg end)
+ (mime-edit-translate-region beg end boundary)))
+ (ctype (car ret))
+ (encoding (nth 1 ret)))
+ (goto-char beg)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (goto-char (point-min))
+ (while (progn (end-of-line) (not (eobp)))
+ (insert "\r")
+ (forward-line 1))
+ (or (smime-encrypt-region (point-min)(point-max))
+ (throw 'mime-edit-error 'pgp-error)
+ )
+ (delete-region (point-min)(point-max))
+ (insert "--[[application/pkcs7-mime; name=\"smime.p7m\"
+Content-Disposition: attachment; filename=\"smime.p7m\"
+Content-Description: S/MIME Encrypted Message][base64]]\n")
+ (insert-buffer-substring smime-output-buffer)
+ ))))
+
(defsubst replace-space-with-underline (str)
(mapconcat (function
(lambda (arg)
;; (point)
;; 'hard t)))
;; End patch for hard newlines
- (enriched-encode beg end)
+ (enriched-encode beg end nil)
(goto-char beg)
(if (search-forward "\n\n")
(delete-region beg (match-end 0))
(mime-edit-enclose-region-internal 'kazu-encrypted beg end)
)
+(defun mime-edit-enclose-smime-signed-region (beg end)
+ (interactive "*r")
+ (mime-edit-enclose-region-internal 'smime-signed beg end)
+ )
+
+(defun mime-edit-enclose-smime-encrypted-region (beg end)
+ (interactive "*r")
+ (mime-edit-enclose-region-internal 'smime-encrypted beg end)
+ )
+
(defun mime-edit-insert-key (&optional arg)
"Insert a pgp public key."
(interactive "P")
(mime-edit-insert-tag "application" "pgp-keys")
(mime-edit-define-encoding "7bit")
- (funcall (pgp-function 'insert-key))
- )
+ (pgg-insert-key)
+ (if (and (not (eobp))
+ (not (looking-at mime-edit-single-part-tag-regexp)))
+ (insert (mime-make-text-tag) "\n")))
;;; @ flag setting
))
(if arg
(progn
- (setq mime-edit-pgp-processing 'sign)
+ (or (memq 'sign mime-edit-pgp-processing)
+ (setq mime-edit-pgp-processing
+ (nconc mime-edit-pgp-processing
+ (copy-sequence '(sign)))))
(message "This message will be signed.")
)
- (if (eq mime-edit-pgp-processing 'sign)
- (setq mime-edit-pgp-processing nil)
- )
+ (setq mime-edit-pgp-processing
+ (delq 'sign mime-edit-pgp-processing))
(message "This message will not be signed.")
))
))
(if arg
(progn
- (setq mime-edit-pgp-processing 'encrypt)
+ (or (memq 'encrypt mime-edit-pgp-processing)
+ (setq mime-edit-pgp-processing
+ (nconc mime-edit-pgp-processing
+ (copy-sequence '(encrypt)))))
(message "This message will be encrypt.")
)
- (if (eq mime-edit-pgp-processing 'encrypt)
- (setq mime-edit-pgp-processing nil)
- )
+ (setq mime-edit-pgp-processing
+ (delq 'encrypt mime-edit-pgp-processing))
(message "This message will not be encrypt.")
))
(if (search-forward (concat "\n" mail-header-separator "\n"))
(match-end 0)
)))
- (end (point-max))
)
(if beg
- (cond ((eq mime-edit-pgp-processing 'sign)
- (mime-edit-enclose-pgp-signed-region beg end)
- )
- ((eq mime-edit-pgp-processing 'encrypt)
- (mime-edit-enclose-pgp-encrypted-region beg end)
- ))
+ (dolist (pgp-processing mime-edit-pgp-processing)
+ (case pgp-processing
+ (sign
+ (mime-edit-enclose-pgp-signed-region
+ beg (point-max))
+ )
+ (encrypt
+ (mime-edit-enclose-pgp-encrypted-region
+ beg (point-max))
+ )))
)))
(buf-name (buffer-name))
(temp-buf-name (concat "*temp-article:" buf-name "*"))
(buf (get-buffer temp-buf-name))
+ (pgp-processing mime-edit-pgp-processing)
)
(if buf
(progn
(setq mail-header-separator separator)
(make-local-variable 'mime-edit-buffer)
(setq mime-edit-buffer the-buf)
+ (setq mime-edit-pgp-processing pgp-processing)
(run-hooks 'mime-edit-translate-hook)
(mime-edit-translate-buffer)
(replace-match "")
)
(mime-view-buffer)
- ))
+ (make-local-variable 'mime-edit-temp-message-buffer)
+ (setq mime-edit-temp-message-buffer buf)))
(defun mime-edit-quitting-method ()
"Quitting method for mime-view."
- (let* ((entity (get-text-property (point-min) 'mime-view-entity))
- (temp (mime-entity-buffer entity))
+ (let* ((temp mime-edit-temp-message-buffer)
buf)
(mime-preview-kill-buffer)
(set-buffer temp)
(setq buf mime-edit-buffer)
(kill-buffer temp)
- (switch-to-buffer buf)
- ))
+ (switch-to-buffer buf)))
(set-alist 'mime-preview-quitting-method-alist
'mime-temp-message-mode
string))
(defun mime-edit-decode-multipart-in-buffer (content-type not-decode-text)
- (let* ((subtype (mime-content-type-subtype content-type))
+ (let* ((subtype
+ (or
+ (cdr (assoc (mime-content-type-parameter content-type "protocol")
+ '(("application/pgp-encrypted" . pgp-encrypted)
+ ("application/pgp-signature" . pgp-signed))))
+ (mime-content-type-subtype content-type)))
(boundary (mime-content-type-parameter content-type "boundary"))
(boundary-pat (concat "\n--" (regexp-quote boundary) "[ \t]*\n")))
(re-search-forward boundary-pat nil t)
)
(save-restriction
(narrow-to-region beg end)
- (mime-edit-decode-message-in-buffer
- (if (eq subtype 'digest)
- (eval-when-compile
- (make-mime-content-type 'message 'rfc822))
- )
- not-decode-text)
- (goto-char (point-max))
+ (cond
+ ((eq subtype 'pgp-encrypted)
+ (when (and
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP MESSAGE-+$"
+ nil t))
+ (prog1
+ (save-window-excursion
+ (pgg-decrypt-region (match-beginning 0)
+ (point-max)))
+ (delete-region (point-min)(point-max))))
+ (insert-buffer-substring pgg-output-buffer)
+ (mime-edit-decode-message-in-buffer
+ nil not-decode-text)
+ (delete-region (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (match-end 0)
+ (point-min)))
+ (goto-char (point-max))
+ ))
+ (t
+ (mime-edit-decode-message-in-buffer
+ (if (eq subtype 'digest)
+ (eval-when-compile
+ (make-mime-content-type 'message 'rfc822))
+ )
+ not-decode-text)
+ (goto-char (point-max))
+ ))
))))
))
(goto-char (point-min))
)))
))
-(defun mime-edit-decode-single-part-in-buffer (content-type not-decode-text)
+(defun mime-edit-decode-single-part-in-buffer
+ (content-type not-decode-text &optional content-disposition)
(let* ((type (mime-content-type-primary-type content-type))
(subtype (mime-content-type-subtype content-type))
(ctype (format "%s/%s" type subtype))
encoded
(limit (save-excursion
(if (search-forward "\n\n" nil t)
- (1- (point))))))
+ (1- (point)))))
+ (disposition-type
+ (mime-content-disposition-type content-disposition))
+ (disposition-str
+ (if disposition-type
+ (let ((bytes (+ 21 (length (format "%s" disposition-type)))))
+ (mapconcat (function
+ (lambda (attr)
+ (let* ((str (concat
+ (car attr)
+ "="
+ (if (string-equal "filename"
+ (car attr))
+ (std11-wrap-as-quoted-string
+ (cdr attr))
+ (cdr attr))))
+ (bs (length str)))
+ (setq bytes (+ bytes bs 2))
+ (if (< bytes 76)
+ (concat "; " str)
+ (setq bytes (+ bs 1))
+ (concat ";\n " str)
+ )
+ )))
+ (mime-content-disposition-parameters
+ content-disposition)
+ ""))))
+ )
+ (if disposition-type
+ (setq pstr (format "%s\nContent-Disposition: %s%s"
+ pstr disposition-type disposition-str))
+ )
(save-excursion
(if (re-search-forward
"^Content-Transfer-Encoding:" limit t)
(mime-edit-decode-multipart-in-buffer ctl not-decode-text)
)
(t
- (mime-edit-decode-single-part-in-buffer ctl not-decode-text)
+ (mime-edit-decode-single-part-in-buffer
+ ctl not-decode-text (mime-read-Content-Disposition))
)))
(or not-decode-text
(decode-mime-charset-region (point-min) (point-max)
default-mime-charset))
)
- (save-restriction
- (std11-narrow-to-header)
- (goto-char (point-min))
- (while (re-search-forward mime-edit-again-ignored-field-regexp nil t)
- (delete-region (match-beginning 0) (1+ (std11-field-end)))
- ))
- (mime-decode-header-in-buffer (not not-decode-text))
+ (if (= (point-min) 1)
+ (progn
+ (save-restriction
+ (std11-narrow-to-header)
+ (goto-char (point-min))
+ (while (re-search-forward
+ mime-edit-again-ignored-field-regexp nil t)
+ (delete-region (match-beginning 0) (1+ (std11-field-end)))
+ ))
+ (mime-decode-header-in-buffer (not not-decode-text))
+ ))
)))
;;;###autoload
;; Copyright (C) 1996 Dan Rich
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Dan Rich <drich@morpheus.corp.sgi.com>
+;; Dan Rich <drich@morpheus.corp.sgi.com>
+;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Created: 1995/12/15
;; Renamed: 1997/2/21 from tm-image.el
;;; Code:
-(require 'mime-view)
-(require 'alist)
+(eval-when-compile (require 'cl))
-(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 bitmap-insert-xbm-file (file)
- (let ((gl (make-glyph (list (cons 'x file))))
- (e (make-extent (point) (point)))
- )
- (set-extent-end-glyph e gl)
- ))
-
- ;;
- ;; X-Face
- ;;
- (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)
-
- )
- ((featurep 'mule)
- ;; for MULE 2.* or mule merged EMACS
- (require 'x-face-mule)
-
- (defvar image-native-formats '(xbm))
-
- (defun-maybe image-inline-p (format)
- (memq format image-native-formats)
- )
-
- (defun-maybe image-normalize (format data)
- (and (eq format 'xbm)
- (vector 'xbm ':data data)
- ))
-
- ;;
- ;; X-Face
- ;;
- (if (exec-installed-p uncompface-program exec-path)
- (add-hook 'mime-display-header-hook
- 'x-face-decode-message-header)
- )
- ))
-
-(or (fboundp 'image-invalid-glyph-p)
- (defsubst image-invalid-glyph-p (glyph)
- (or (null (aref glyph 0))
- (null (aref glyph 2))
- (equal (aref glyph 2) "")
- ))
- )
-
-(mapcar (function
- (lambda (rule)
- (let ((type (car rule))
- (subtype (nth 1 rule))
- (format (nth 2 rule)))
- (if (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))
- )))))
- '((image jpeg jpeg)
- (image gif gif)
- (image tiff tiff)
- (image x-tiff tiff)
- (image xbm xbm)
- (image x-xbm xbm)
- (image x-xpixmap xpm)
- (image x-pic pic)
- (image x-mag mag)
- (image png png)
- ))
+(eval-when-compile (require 'static))
+(require 'mime-view)
+(require 'alist)
+(require 'path-util)
+
+(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 ((glyph
+ (make-glyph
+ (if (and type (mime-image-type-available-p type))
+ (vconcat
+ (list type (if data-p :data :file) file-or-data)
+ props)
+ file-or-data))))
+ (if (nothing-image-instance-p (glyph-image-instance glyph)) nil
+ glyph)))
+
+ (defun mime-image-insert (image &optional string area)
+ (let ((extent (make-extent (point)
+ (progn (and string
+ (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 &optional string area)
+ (insert image)))
+ (error
+ (defalias 'mime-image-read-xbm-buffer
+ 'mime-image-normalize-xbm-buffer)
+ (defun mime-image-insert (image &optional string 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 gif gif)
+ (image tiff tiff)
+ (image x-tiff tiff)
+ (image xbm xbm)
+ (image x-xbm xbm)
+ (image x-xpixmap xpm)
+ (image png png)))
+
+(dolist (rule mime-image-format-alist)
+ (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
;;;
(defun mime-display-image (entity situation)
(message "Decoding image...")
- (let ((gl (image-normalize (cdr (assq 'image-format situation))
- (mime-entity-content entity))))
- (cond ((image-invalid-glyph-p gl)
- (setq gl nil)
- (message "Invalid glyph!")
- )
- ((eq (aref gl 0) 'xbm)
- (let ((xbm-file
- (make-temp-name
- (expand-file-name "tm" temporary-file-directory))))
- (with-temp-buffer
- (insert (aref gl 2))
- (write-region (point-min)(point-max) xbm-file)
- )
- (message "Decoding image...")
- (bitmap-insert-xbm-file xbm-file)
- (delete-file xbm-file)
- )
- (message "Decoding image... done")
- )
- (t
- (setq gl (make-glyph gl))
- (let ((e (make-extent (point) (point))))
- (set-extent-end-glyph e gl)
- )
- (message "Decoding image... done")
- ))
- )
- (insert "\n")
- )
-
+ (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!")
+ (save-excursion
+ (mime-image-insert image)
+ (insert "\n")
+ (message "Decoding image... done")))))
;;; @ end
;;;
;;; mime-pgp.el --- mime-view internal methods for PGP.
-;; Copyright (C) 1995,1996,1997,1998,1999 MORIOKA Tomohiko
+;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
;; Created: 1995/12/7
;; Renamed: 1997/2/27 from tm-pgp.el
;; Keywords: PGP, security, MIME, multimedia, mail, news
;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
;; expired)
+;; [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
+;; Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
+;; <kazu@iijlab.net> (1998/1)
+
;;; Code:
(require 'mime-play)
+(require 'pgg-def)
+
+(autoload 'pgg-decrypt-region "pgg"
+ "PGP decryption of current region." t)
+(autoload 'pgg-verify-region "pgg"
+ "PGP verification of current region." t)
+(autoload 'pgg-snarf-keys-region "pgg"
+ "Snarf PGP public keys in current region." t)
+(autoload 'smime-decrypt-region "smime"
+ "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
(new-name
(format "%s-%s" (buffer-name) (mime-entity-number entity)))
(mother (current-buffer))
- representation-type)
- (set-buffer (get-buffer-create new-name))
+ (preview-buffer (concat "*Preview-" (buffer-name) "*"))
+ representation-type message-buf)
+ (set-buffer (setq message-buf (get-buffer-create new-name)))
(erase-buffer)
(mime-insert-entity entity)
(cond ((progn
(goto-char (point-min))
(re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
- (funcall (pgp-function 'verify))
+ (pgg-verify-region (match-beginning 0)(point-max) nil 'fetch)
(goto-char (point-min))
(delete-region
(point-min)
(point-max))
(goto-char (point-min))
(while (re-search-forward "^- -" nil t)
- (replace-match "-")
- )
+ (replace-match "-"))
(setq representation-type (if (mime-entity-cooked-p entity)
- 'cooked))
- )
+ 'cooked)))
((progn
(goto-char (point-min))
(re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
- (as-binary-process (funcall (pgp-function 'decrypt)))
- (goto-char (point-min))
- (delete-region (point-min)
- (and
- (search-forward "\n\n")
- (match-end 0)))
- (setq representation-type 'binary)
- ))
+ (pgg-decrypt-region (point-min)(point-max))
+ (delete-region (point-min)(point-max))
+ (insert-buffer pgg-output-buffer)
+ (setq representation-type 'binary)))
(setq major-mode 'mime-show-message-mode)
- (save-window-excursion (mime-view-buffer nil nil mother
- nil representation-type))
- (set-window-buffer p-win mime-preview-buffer)
- ))
+ (save-window-excursion
+ (mime-view-buffer nil preview-buffer mother
+ nil representation-type)
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer message-buf))
+ (set-window-buffer p-win preview-buffer)))
;;; @ Internal method for application/pgp-signature
;;;
-;;; It is based on RFC 2015 (PGP/MIME).
-
-(defvar mime-pgp-command "pgp"
- "*Name of the PGP command.")
-
-(defvar mime-pgp-default-language 'en
- "*Symbol of language for pgp.
-It should be ISO 639 2 letter language code such as en, ja, ...")
-
-(defvar mime-pgp-good-signature-regexp-alist
- '((en . "Good signature from user.*$"))
- "Alist of language vs regexp to detect ``Good signature''.")
-
-(defvar mime-pgp-key-expected-regexp-alist
- '((en . "Key matching expected Key ID \\(\\S +\\) not found"))
- "Alist of language vs regexp to detect ``Key expected''.")
-
-(defun mime-pgp-check-signature (output-buffer sig-file orig-file)
- (save-excursion
- (set-buffer output-buffer)
- (erase-buffer))
- (let* ((lang (or mime-pgp-default-language 'en))
- (status (call-process-region (point-min)(point-max)
- mime-pgp-command
- nil output-buffer nil
- sig-file orig-file (format "+language=%s" lang)))
- (regexp (cdr (assq lang mime-pgp-good-signature-regexp-alist))))
- (if (= status 0)
- (save-excursion
- (set-buffer output-buffer)
- (goto-char (point-min))
- (message
- (cond ((not (stringp regexp))
- "Please specify right regexp for specified language")
- ((re-search-forward regexp nil t)
- (buffer-substring (match-beginning 0) (match-end 0)))
- (t "Bad signature")))
- ))))
+;;; It is based on RFC 2015 (PGP/MIME) and
+;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
(defun mime-verify-application/pgp-signature (entity situation)
"Internal method to check PGP/MIME signature."
(1+ knum)))
(orig-entity (nth onum (mime-entity-children mother)))
(basename (expand-file-name "tm" temporary-file-directory))
- (orig-file (make-temp-name basename))
- (sig-file (concat orig-file ".sig"))
- )
- (mime-write-entity orig-entity orig-file)
- (save-excursion (mime-show-echo-buffer))
+ (sig-file (concat (make-temp-name basename) ".asc"))
+ status)
+ (save-excursion
+ (mime-show-echo-buffer)
+ (set-buffer mime-echo-buffer-name)
+ (set-window-start
+ (get-buffer-window mime-echo-buffer-name)
+ (point-max)))
(mime-write-entity-content entity sig-file)
- (or (mime-pgp-check-signature mime-echo-buffer-name sig-file orig-file)
- (let (pgp-id)
- (save-excursion
+ (unwind-protect
+ (with-temp-buffer
+ (mime-insert-entity orig-entity)
+ (goto-char (point-min))
+ (while (progn (end-of-line) (not (eobp)))
+ (insert "\r")
+ (forward-line 1))
+ (setq status (pgg-verify-region (point-min)(point-max)
+ sig-file 'fetch))
+ (save-excursion
(set-buffer mime-echo-buffer-name)
- (goto-char (point-min))
- (let ((regexp (cdr (assq (or mime-pgp-default-language 'en)
- mime-pgp-key-expected-regexp-alist))))
- (cond ((not (stringp regexp))
- (message
- "Please specify right regexp for specified language")
- )
- ((re-search-forward regexp nil t)
- (setq pgp-id
- (concat "0x" (buffer-substring-no-properties
- (match-beginning 1)
- (match-end 1))))
- ))))
- (if (and pgp-id
- (y-or-n-p
- (format "Key %s not found; attempt to fetch? " pgp-id))
- )
- (progn
- (funcall (pgp-function 'fetch-key) (cons nil pgp-id))
- (mime-pgp-check-signature mime-echo-buffer-name orig-file)
- ))
- ))
- (let ((other-window-scroll-buffer mime-echo-buffer-name))
- (scroll-other-window 8)
- )
- (delete-file orig-file)
- (delete-file sig-file)
- ))
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer))))
+ (delete-file sig-file))))
;;; @ Internal method for application/pgp-encrypted
;;;
-;;; It is based on RFC 2015 (PGP/MIME).
+;;; It is based on RFC 2015 (PGP/MIME) and
+;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
(defun mime-decrypt-application/pgp-encrypted (entity situation)
(let* ((entity-node-id (mime-entity-node-id entity))
(1- knum)
(1+ knum)))
(orig-entity (nth onum (mime-entity-children mother))))
- (mime-view-application/pgp orig-entity situation)
- ))
+ (mime-view-application/pgp orig-entity situation)))
;;; @ Internal method for application/pgp-keys
;;;
-;;; It is based on RFC 2015 (PGP/MIME).
+;;; It is based on RFC 2015 (PGP/MIME) and
+;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
(defun mime-add-application/pgp-keys (entity situation)
- (let* ((start (mime-entity-point-min entity))
- (end (mime-entity-point-max entity))
- (entity-number (mime-entity-number entity))
- (new-name (format "%s-%s" (buffer-name) entity-number))
- (encoding (cdr (assq 'encoding situation)))
- str)
- (setq str (buffer-substring start end))
- (switch-to-buffer new-name)
- (setq buffer-read-only nil)
- (erase-buffer)
- (insert str)
- (goto-char (point-min))
- (if (re-search-forward "^\n" nil t)
- (delete-region (point-min) (match-end 0))
- )
- (mime-decode-region (point-min)(point-max) encoding)
- (funcall (pgp-function 'snarf-keys))
- (kill-buffer (current-buffer))
- ))
-
-
+ (save-excursion
+ (mime-show-echo-buffer)
+ (set-buffer mime-echo-buffer-name)
+ (set-window-start
+ (get-buffer-window mime-echo-buffer-name)
+ (point-max)))
+ (with-temp-buffer
+ (mime-insert-entity-content entity)
+ (mime-decode-region (point-min) (point-max)
+ (cdr (assq 'encoding situation)))
+ (let ((status (pgg-snarf-keys-region (point-min)(point-max))))
+ (save-excursion
+ (set-buffer mime-echo-buffer-name)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer))))))
+
+
+;;; @ Internal method for application/pkcs7-signature
+;;;
+;;; It is based on RFC 2633 (S/MIME version 3).
+
+(defun mime-verify-application/pkcs7-signature (entity situation)
+ "Internal method to check S/MIME signature."
+ (let* ((entity-node-id (mime-entity-node-id entity))
+ (mother (mime-entity-parent entity))
+ (knum (car entity-node-id))
+ (onum (if (> knum 0)
+ (1- knum)
+ (1+ knum)))
+ (orig-entity (nth onum (mime-entity-children mother)))
+ (basename (expand-file-name "tm" temporary-file-directory))
+ (sig-file (concat (make-temp-name basename) ".asc"))
+ status)
+ (save-excursion
+ (mime-show-echo-buffer)
+ (set-buffer mime-echo-buffer-name)
+ (set-window-start
+ (get-buffer-window mime-echo-buffer-name)
+ (point-max)))
+ (mime-write-entity entity sig-file)
+ (unwind-protect
+ (with-temp-buffer
+ (mime-insert-entity orig-entity)
+ (goto-char (point-min))
+ (while (progn (end-of-line) (not (eobp)))
+ (insert "\r")
+ (forward-line 1))
+ (setq status (smime-verify-region (point-min)(point-max)
+ sig-file))
+ (save-excursion
+ (set-buffer mime-echo-buffer-name)
+ (insert-buffer-substring (if status smime-output-buffer
+ smime-errors-buffer))))
+ (delete-file sig-file))))
+
+
+;;; @ Internal method for application/pkcs7-mime
+;;;
+;;; It is based on RFC 2633 (S/MIME version 3).
+
+(defun mime-view-application/pkcs7-mime (entity situation)
+ (let* ((p-win (or (get-buffer-window (current-buffer))
+ (get-largest-window)))
+ (new-name
+ (format "%s-%s" (buffer-name) (mime-entity-number entity)))
+ (mother (current-buffer))
+ (preview-buffer (concat "*Preview-" (buffer-name) "*"))
+ message-buf)
+ (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data)
+ '(enveloped-data signed-data))
+ (set-buffer (setq message-buf (get-buffer-create new-name)))
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (erase-buffer)
+ (mime-insert-entity entity)
+ (smime-decrypt-region (point-min)(point-max))
+ (delete-region (point-min)(point-max))
+ (insert-buffer smime-output-buffer))
+ (setq major-mode 'mime-show-message-mode)
+ (save-window-excursion
+ (mime-view-buffer nil preview-buffer mother
+ nil 'binary)
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer message-buf))
+ (set-window-buffer p-win preview-buffer))))
+
+
;;; @ end
;;;
;;; mime-play.el --- Playback processing module for mime-view.el
-;; Copyright (C) 1994,1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Created: 1995/9/26 (separated from tm-view.el)
;; Renamed: 1997/2/21 from tm-play.el
;; Keywords: MIME, multimedia, mail, news
(error (defvar bbdb-buffer-name nil)))
)
-(defvar mime-acting-situation-example-list nil)
-
-(defvar mime-acting-situation-example-list-max-size 16)
-
-(defun mime-save-acting-situation-examples ()
- (let* ((file mime-acting-situation-examples-file)
- (buffer (get-buffer-create " *mime-example*")))
- (unwind-protect
- (save-excursion
- (set-buffer buffer)
- (setq buffer-file-name file)
- (erase-buffer)
- (insert ";;; " (file-name-nondirectory file) "\n")
- (insert "\n;; This file is generated automatically by "
- mime-view-version "\n\n")
- (insert ";;; Code:\n\n")
- (pp `(setq mime-acting-situation-example-list
- ',mime-acting-situation-example-list)
- (current-buffer))
- (insert "\n;;; "
- (file-name-nondirectory file)
- " ends here.\n")
- (save-buffer))
- (kill-buffer buffer))))
-
-(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)
-
-(defun mime-reduce-acting-situation-examples ()
- (let ((len (length mime-acting-situation-example-list))
- i ir ic j jr jc ret
- dest d-i d-j
- (max-sim 0) sim
- min-det-ret det-ret
- min-det-org det-org
- min-freq freq)
- (setq i 0
- ir mime-acting-situation-example-list)
- (while (< i len)
- (setq ic (car ir)
- j 0
- jr mime-acting-situation-example-list)
- (while (< j len)
- (unless (= i j)
- (setq jc (car jr))
- (setq ret (mime-compare-situation-with-example (car ic)(car jc))
- sim (car ret)
- det-ret (+ (length (car ic))(length (car jc)))
- det-org (length (cdr ret))
- freq (+ (cdr ic)(cdr jc)))
- (cond ((< max-sim sim)
- (setq max-sim sim
- min-det-ret det-ret
- min-det-org det-org
- min-freq freq
- d-i i
- d-j j
- dest (cons (cdr ret) freq))
- )
- ((= max-sim sim)
- (cond ((> min-det-ret det-ret)
- (setq min-det-ret det-ret
- min-det-org det-org
- min-freq freq
- d-i i
- d-j j
- dest (cons (cdr ret) freq))
- )
- ((= min-det-ret det-ret)
- (cond ((> min-det-org det-org)
- (setq min-det-org det-org
- min-freq freq
- d-i i
- d-j j
- dest (cons (cdr ret) freq))
- )
- ((= min-det-org det-org)
- (cond ((> min-freq freq)
- (setq min-freq freq
- d-i i
- d-j j
- dest (cons (cdr ret) freq))
- ))
- ))
- ))
- ))
- )
- (setq jr (cdr jr)
- j (1+ j)))
- (setq ir (cdr ir)
- i (1+ i)))
- (if (> d-i d-j)
- (setq i d-i
- d-i d-j
- d-j i))
- (setq jr (nthcdr (1- d-j) mime-acting-situation-example-list))
- (setcdr jr (cddr jr))
- (if (= d-i 0)
- (setq mime-acting-situation-example-list
- (cdr mime-acting-situation-example-list))
- (setq ir (nthcdr (1- d-i) mime-acting-situation-example-list))
- (setcdr ir (cddr ir))
- )
- (if (setq ir (assoc (car dest) mime-acting-situation-example-list))
- (setcdr ir (+ (cdr ir)(cdr dest)))
- (setq mime-acting-situation-example-list
- (cons dest mime-acting-situation-example-list))
- )))
+(defcustom mime-save-directory "~/"
+ "*Name of the directory where MIME entity will be saved in.
+If t, it means current directory."
+ :group 'mime-view
+ :type '(choice (const :tag "Current directory" t)
+ (directory)))
+
+(defvar mime-play-find-every-situations t
+ "*Find every available situations if non-nil.")
;;; @ content decoder
(mime-play-entity entity situation)
))))
-(defun mime-sort-situation (situation)
- (sort situation
- #'(lambda (a b)
- (let ((a-t (car a))
- (b-t (car b))
- (order '((type . 1)
- (subtype . 2)
- (mode . 3)
- (method . 4)
- (major-mode . 5)
- (disposition-type . 6)
- ))
- a-order b-order)
- (if (symbolp a-t)
- (let ((ret (assq a-t order)))
- (if ret
- (setq a-order (cdr ret))
- (setq a-order 7)
- ))
- (setq a-order 8)
- )
- (if (symbolp b-t)
- (let ((ret (assq b-t order)))
- (if ret
- (setq b-order (cdr ret))
- (setq b-order 7)
- ))
- (setq b-order 8)
- )
- (if (= a-order b-order)
- (string< (format "%s" a-t)(format "%s" b-t))
- (< a-order b-order))
- )))
- )
-
-(defsubst mime-delq-null-situation (situations field
- &optional ignored-value)
- (let (dest)
- (while situations
- (let* ((situation (car situations))
- (cell (assq field situation)))
- (if cell
- (or (eq (cdr cell) ignored-value)
- (setq dest (cons situation dest))
- )))
- (setq situations (cdr situations)))
- dest))
-
-(defun mime-compare-situation-with-example (situation example)
- (let ((example (copy-alist example))
- (match 0))
- (while situation
- (let* ((cell (car situation))
- (key (car cell))
- (ecell (assoc key example)))
- (when ecell
- (if (equal cell ecell)
- (setq match (1+ match))
- (setq example (delq ecell example))
- ))
- )
- (setq situation (cdr situation))
- )
- (cons match example)
- ))
-
;;;###autoload
(defun mime-play-entity (entity &optional situation ignored-method)
"Play entity specified by ENTITY.
It decodes the entity to call internal or external method. The method
is selected from variable `mime-acting-condition'. If MODE is
specified, play as it. Default MODE is \"play\"."
- (let (method ret)
- (in-calist-package 'mime-view)
- (setq ret
- (mime-delq-null-situation
- (ctree-find-calist mime-acting-condition
- (mime-entity-situation entity situation)
- mime-view-find-every-acting-situation)
- 'method ignored-method))
- (or (assq 'ignore-examples situation)
- (if (cdr ret)
- (let ((rest ret)
- (max-score 0)
- (max-escore 0)
- max-examples
- max-situations)
- (while rest
- (let ((situation (car rest))
- (examples mime-acting-situation-example-list))
- (while examples
- (let* ((ret
- (mime-compare-situation-with-example
- situation (caar examples)))
- (ret-score (car ret)))
- (cond ((> ret-score max-score)
- (setq max-score ret-score
- max-escore (cdar examples)
- max-examples (list (cdr ret))
- max-situations (list situation))
- )
- ((= ret-score max-score)
- (cond ((> (cdar examples) max-escore)
- (setq max-escore (cdar examples)
- max-examples (list (cdr ret))
- max-situations (list situation))
- )
- ((= (cdar examples) max-escore)
- (setq max-examples
- (cons (cdr ret) max-examples))
- (or (member situation max-situations)
- (setq max-situations
- (cons situation max-situations)))
- )))))
- (setq examples (cdr examples))))
- (setq rest (cdr rest)))
- (when max-situations
- (setq ret max-situations)
- (while max-examples
- (let* ((example (car max-examples))
- (cell
- (assoc example mime-acting-situation-example-list)))
- (if cell
- (setcdr cell (1+ (cdr cell)))
- (setq mime-acting-situation-example-list
- (cons (cons example 0)
- mime-acting-situation-example-list))
- ))
- (setq max-examples (cdr max-examples))
- )))))
+ (let ((ret
+ (mime-unify-situations (mime-entity-situation entity situation)
+ mime-acting-condition
+ mime-acting-situation-example-list
+ 'method ignored-method
+ mime-play-find-every-situations))
+ method)
+ (setq mime-acting-situation-example-list (cdr ret)
+ ret (car ret))
(cond ((cdr ret)
(setq ret (select-menu-alist
"Methods"
;;;
(defun mime-save-content (entity situation)
- (let* ((name (mime-entity-safe-filename entity))
- (filename (if (and name (not (string-equal name "")))
- (expand-file-name name
- (save-window-excursion
- (call-interactively
- (function
- (lambda (dir)
- (interactive "DDirectory: ")
- dir)))))
- (save-window-excursion
- (call-interactively
- (function
- (lambda (file)
- (interactive "FFilename: ")
- (expand-file-name file)))))))
- )
+ (let ((name (or (mime-entity-safe-filename entity)
+ (format "%s" (mime-entity-media-type entity))))
+ (dir (if (eq t mime-save-directory)
+ default-directory
+ mime-save-directory))
+ filename)
+ (setq filename (read-file-name
+ (concat "File name: (default "
+ (file-name-nondirectory name) ") ")
+ dir
+ (concat (file-name-as-directory dir)
+ (file-name-nondirectory name))))
+ (if (file-directory-p filename)
+ (setq filename (concat (file-name-as-directory filename)
+ (file-name-nondirectory name))))
(if (file-exists-p filename)
(or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
(error "")))
- (mime-write-entity-content entity filename)
+ (mime-write-entity-content entity (expand-file-name filename))
))
(defun mime-preview-quitting-method-for-mime-show-message-mode ()
"Quitting method for mime-view.
It is registered to variable `mime-preview-quitting-method-alist'."
- (let ((raw-buffer (mime-entity-buffer
- (get-text-property (point-min) 'mime-view-entity)))
- (mother mime-mother-buffer)
+ (let ((mother mime-mother-buffer)
(win-conf mime-preview-original-window-configuration))
- (kill-buffer raw-buffer)
+ (if (and (boundp 'mime-view-temp-message-buffer)
+ (buffer-live-p mime-view-temp-message-buffer))
+ (kill-buffer mime-view-temp-message-buffer))
(mime-preview-kill-buffer)
(set-window-configuration win-conf)
- (pop-to-buffer mother)
- ))
+ (pop-to-buffer mother)))
(defun mime-view-message/rfc822 (entity situation)
(let* ((new-name
(save-window-excursion
(set-buffer full-buf)
(erase-buffer)
- (as-binary-input-file (insert-file-contents file))
+ (insert-file-contents-as-binary file)
(setq major-mode 'mime-show-message-mode)
(mime-view-buffer (current-buffer) nil mother)
(setq pbuf (current-buffer))
- )
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer full-buf))
(set-window-buffer pwin pbuf)
- (select-window pwin)
- )
+ (select-window pwin))
(setq file (concat root-dir "/" number))
(mime-write-entity-body entity file)
(let ((total-file (concat root-dir "/CT")))
(goto-char (point-max))
(setq i (1+ i))
))
- (as-binary-output-file
- (write-region (point-min)(point-max)
- (expand-file-name "FULL" root-dir)))
+ (write-region-as-binary (point-min)(point-max)
+ (expand-file-name "FULL" root-dir))
(let ((i 1))
(while (<= i total)
(let ((file (format "%s/%d" root-dir i)))
(and (file-exists-p file)
(delete-file file)
))
- (let ((pwin (or (get-buffer-window mother)
+ (let ((buf (current-buffer))
+ (pwin (or (get-buffer-window mother)
(get-largest-window)))
(pbuf (mime-display-message
(mime-open-entity 'buffer (current-buffer))
nil mother nil 'mime-show-message-mode)))
+ (with-current-buffer pbuf
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer buf))
(set-window-buffer pwin pbuf)
(select-window pwin)
)))))
(provide 'mime-play)
-(let* ((file mime-acting-situation-examples-file)
- (buffer (get-buffer-create " *mime-example*")))
- (if (file-readable-p file)
- (unwind-protect
- (save-excursion
- (set-buffer buffer)
- (erase-buffer)
- (insert-file-contents file)
- (eval-buffer)
- ;; format check
- (condition-case nil
- (let ((i 0))
- (while (and (> (length mime-acting-situation-example-list)
- mime-acting-situation-example-list-max-size)
- (< i 16))
- (mime-reduce-acting-situation-examples)
- (setq i (1+ i))
- ))
- (error (setq mime-acting-situation-example-list nil)))
- )
- (kill-buffer buffer))))
-
;;; mime-play.el ends here
</dd>
<kt>C-c C-x C-k
<kd>
-Insert <dref>PGP</dref> public key. (It requires Mailcrypt package.)
+Insert <dref>PGP</dref> public key.
</kd>
<kt>C-c C-x t
<kd>
features based on <concept>PGP/MIME</concept> (RFC 2015) or
<concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt).
<p>
-This feature requires pgp command and pgp interface package, such as
-<a file="mailcrypt">Mailcrypt package</a>.
+This feature requires your pgp command.
-<defvar name="pgp-function-alist">
+<defvar name="pgg-default-scheme">
<p>
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like <code>(SERVICE FUNCTION FILE)</code>.
-<p>
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt'
-or `insert-key'.
-<p>
-Function is a symbol of function to do specified SERVICE.
-<p>
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
</defvar>
-<defun name="pgp-function">
- <args> method
+<defvar name="pgg-scheme">
<p>
-Return function to do service <var>method</var>.
-</defun>
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
+</defvar>
<h2> Mouse button
features based on @strong{PGP/MIME} (RFC 2015) or @strong{PGP-kazu}
(draft-kazu-pgp-mime-00.txt).@refill
-This feature requires pgp command and pgp interface package, such as
-Mailcrypt package (@ref{(mailcrypt)}).
+This feature requires your pgp command.
-@defvar pgp-function-alist
+@defvar pgg-default-scheme
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like @code{(SERVICE FUNCTION FILE)}.@refill
-
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' or
-`insert-key'.@refill
-
-Function is a symbol of function to do specified SERVICE.@refill
-
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
@end defvar
-@defun pgp-function method
+@defvar pgg-scheme
-Return function to do service @var{method}.
-@end defun
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
+@end defvar
<concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&\e(B
\e$BEE;R=pL>!&8x3+80$NA^F~5!G=$rMxMQ$9$k$3$H$,$G$-$^$9!#\e(B
<p>
-
\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O
\e(B <a file="mailcrypt">Mailcrypt package</a>
-\e$B$H\e(B pgp command \e$B$,I,MW$G$9!#\e(B
+\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F<o\e(B pgp command \e$B$,I,MW$G$9!#\e(B
-<defvar name="pgp-function-alist">
+<defvar name="pgg-default-scheme">
<p>
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like <code>(SERVICE FUNCTION FILE)</code>.
-<p>
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt'
-or `insert-key'.
-<p>
-Function is a symbol of function to do specified SERVICE.
-<p>
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
</defvar>
-<defun name="pgp-function">
- <args> method
+<defvar name="pgg-scheme">
<p>
-Return function to do service <var>method</var>.
-</defun>
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
+</defvar>
<h2> \e$B2!KU\e(B
(draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&EE;R=pL>!&8x3+80$NA^F~5!G=$r\e(B
\e$BMxMQ$9$k$3$H$,$G$-$^$9!#\e(B@refill
-\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O\e(B Mailcrypt package (@ref{(mailcrypt)}) \e$B$H\e(B
-pgp command \e$B$,I,MW$G$9!#\e(B
+\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F<o\e(B pgp command \e$B$,I,MW$G$9!#\e(B
-@defvar pgp-function-alist
+@defvar pgg-default-scheme
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like @code{(SERVICE FUNCTION FILE)}.@refill
-
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' or
-`insert-key'.@refill
-
-Function is a symbol of function to do specified SERVICE.@refill
-
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
@end defvar
-@defun pgp-function method
+@defvar pgg-scheme
-Return function to do service @var{method}.
-@end defun
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
+@end defvar
;;; mime-view.el --- interactive MIME viewer for GNU Emacs
-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Created: 1994/07/13
;; Renamed: 1994/08/31 from tm-body.el
;; Renamed: 1997/02/19 from tm-view.el
"MIME view mode"
:group 'mime)
-(defcustom mime-view-find-every-acting-situation t
- "*Find every available acting-situation if non-nil."
- :group 'mime-view
- :type 'boolean)
-
-(defcustom mime-acting-situation-examples-file "~/.mime-example"
- "*File name of example about acting-situation demonstrated by user."
+(defcustom mime-situation-examples-file "~/.mime-example"
+ "*File name of situation-examples demonstrated by user."
:group 'mime-view
:type 'file)
(const :tag "On" t)
(sexp :tag "Situation" 1)))
+
;;; @ in raw-buffer (representation space)
;;;
`binary' or `cooked'.")
-;; (defun mime-raw-find-entity-from-point (point &optional message-info)
-;; "Return entity from POINT in mime-raw-buffer.
-;; If optional argument MESSAGE-INFO is not specified,
-;; `mime-message-structure' is used."
-;; (or message-info
-;; (setq message-info mime-message-structure))
-;; (if (and (<= (mime-entity-point-min message-info) point)
-;; (<= point (mime-entity-point-max message-info)))
-;; (let ((children (mime-entity-children message-info)))
-;; (catch 'tag
-;; (while children
-;; (let ((ret
-;; (mime-raw-find-entity-from-point point (car children))))
-;; (if ret
-;; (throw 'tag ret)
-;; ))
-;; (setq children (cdr children)))
-;; message-info))))
-;; (make-obsolete 'mime-raw-find-entity-from-point "don't use it.")
-
-
;;; @ in preview-buffer (presentation space)
;;;
situation))
+(defsubst mime-delq-null-situation (situations field
+ &rest ignored-values)
+ (let (dest)
+ (while situations
+ (let* ((situation (car situations))
+ (cell (assq field situation)))
+ (if cell
+ (or (memq (cdr cell) ignored-values)
+ (setq dest (cons situation dest))
+ )))
+ (setq situations (cdr situations)))
+ dest))
+
+(defun mime-compare-situation-with-example (situation example)
+ (let ((example (copy-alist example))
+ (match 0))
+ (while situation
+ (let* ((cell (car situation))
+ (key (car cell))
+ (ecell (assoc key example)))
+ (when ecell
+ (if (equal cell ecell)
+ (setq match (1+ match))
+ (setq example (delq ecell example))
+ ))
+ )
+ (setq situation (cdr situation))
+ )
+ (cons match example)
+ ))
+
+(defun mime-sort-situation (situation)
+ (sort situation
+ #'(lambda (a b)
+ (let ((a-t (car a))
+ (b-t (car b))
+ (order '((type . 1)
+ (subtype . 2)
+ (mode . 3)
+ (method . 4)
+ (major-mode . 5)
+ (disposition-type . 6)
+ ))
+ a-order b-order)
+ (if (symbolp a-t)
+ (let ((ret (assq a-t order)))
+ (if ret
+ (setq a-order (cdr ret))
+ (setq a-order 7)
+ ))
+ (setq a-order 8)
+ )
+ (if (symbolp b-t)
+ (let ((ret (assq b-t order)))
+ (if ret
+ (setq b-order (cdr ret))
+ (setq b-order 7)
+ ))
+ (setq b-order 8)
+ )
+ (if (= a-order b-order)
+ (string< (format "%s" a-t)(format "%s" b-t))
+ (< a-order b-order))
+ )))
+ )
+
+(defun mime-unify-situations (entity-situation
+ condition situation-examples
+ &optional required-name ignored-value
+ every-situations)
+ (let (ret)
+ (in-calist-package 'mime-view)
+ (setq ret
+ (ctree-find-calist condition entity-situation
+ every-situations))
+ (if required-name
+ (setq ret (mime-delq-null-situation ret required-name
+ ignored-value t)))
+ (or (assq 'ignore-examples entity-situation)
+ (if (cdr ret)
+ (let ((rest ret)
+ (max-score 0)
+ (max-escore 0)
+ max-examples
+ max-situations)
+ (while rest
+ (let ((situation (car rest))
+ (examples situation-examples))
+ (while examples
+ (let* ((ret
+ (mime-compare-situation-with-example
+ situation (caar examples)))
+ (ret-score (car ret)))
+ (cond ((> ret-score max-score)
+ (setq max-score ret-score
+ max-escore (cdar examples)
+ max-examples (list (cdr ret))
+ max-situations (list situation))
+ )
+ ((= ret-score max-score)
+ (cond ((> (cdar examples) max-escore)
+ (setq max-escore (cdar examples)
+ max-examples (list (cdr ret))
+ max-situations (list situation))
+ )
+ ((= (cdar examples) max-escore)
+ (setq max-examples
+ (cons (cdr ret) max-examples))
+ (or (member situation max-situations)
+ (setq max-situations
+ (cons situation max-situations)))
+ )))))
+ (setq examples (cdr examples))))
+ (setq rest (cdr rest)))
+ (when max-situations
+ (setq ret max-situations)
+ (while max-examples
+ (let* ((example (car max-examples))
+ (cell
+ (assoc example situation-examples)))
+ (if cell
+ (setcdr cell (1+ (cdr cell)))
+ (setq situation-examples
+ (cons (cons example 0)
+ situation-examples))
+ ))
+ (setq max-examples (cdr max-examples))
+ )))))
+ (cons ret situation-examples)
+ ;; ret: list of situations
+ ;; situation-examples: new examples (notoce that contents of
+ ;; argument `situation-examples' has bees modified)
+ ))
+
(defun mime-view-entity-title (entity)
(or (mime-entity-read-field entity 'Content-Description)
(mime-entity-read-field entity 'Subject)
(mime-entity-filename entity)
""))
-
-;; (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
-;; "Return entity-node-id from POINT in mime-raw-buffer.
-;; If optional argument MESSAGE-INFO is not specified,
-;; `mime-message-structure' is used."
-;; (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
-
-;; (make-obsolete 'mime-raw-point-to-entity-node-id "don't use it.")
-
-;; (defsubst mime-raw-point-to-entity-number (point &optional message-info)
-;; "Return entity-number from POINT in mime-raw-buffer.
-;; If optional argument MESSAGE-INFO is not specified,
-;; `mime-message-structure' is used."
-;; (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
-
-;; (make-obsolete 'mime-raw-point-to-entity-number "don't use it.")
-
-;; (defun mime-raw-flatten-message-info (&optional message-info)
-;; "Return list of entity in mime-raw-buffer.
-;; If optional argument MESSAGE-INFO is not specified,
-;; `mime-message-structure' is used."
-;; (or message-info
-;; (setq message-info mime-message-structure))
-;; (let ((dest (list message-info))
-;; (rcl (mime-entity-children message-info)))
-;; (while rcl
-;; (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
-;; (setq rcl (cdr rcl)))
-;; dest))
+(defvar mime-preview-situation-example-list nil)
+(defvar mime-preview-situation-example-list-max-size 16)
+;; (defvar mime-preview-situation-example-condition nil)
+
+(defun mime-find-entity-preview-situation (entity
+ &optional default-situation)
+ (or (let ((ret
+ (mime-unify-situations
+ (append (mime-entity-situation entity)
+ default-situation)
+ mime-preview-condition
+ mime-preview-situation-example-list)))
+ (setq mime-preview-situation-example-list
+ (cdr ret))
+ (caar ret))
+ default-situation))
+
+
+(defvar mime-acting-situation-example-list nil)
+(defvar mime-acting-situation-example-list-max-size 16)
+(defvar mime-situation-examples-file-coding-system nil)
+
+(defun mime-save-situation-examples ()
+ (if (or mime-preview-situation-example-list
+ mime-acting-situation-example-list)
+ (let ((file mime-situation-examples-file))
+ (with-temp-buffer
+ (insert ";;; " (file-name-nondirectory file) "\n")
+ (insert "\n;; This file is generated automatically by "
+ mime-view-version "\n\n")
+ (insert ";;; Code:\n\n")
+ (if mime-preview-situation-example-list
+ (pp `(setq mime-preview-situation-example-list
+ ',mime-preview-situation-example-list)
+ (current-buffer)))
+ (if mime-acting-situation-example-list
+ (pp `(setq mime-acting-situation-example-list
+ ',mime-acting-situation-example-list)
+ (current-buffer)))
+ (insert "\n;;; "
+ (file-name-nondirectory file)
+ " ends here.\n")
+ (static-cond
+ ((boundp 'buffer-file-coding-system)
+ (setq buffer-file-coding-system
+ mime-situation-examples-file-coding-system))
+ ((boundp 'file-coding-system)
+ (setq file-coding-system
+ mime-situation-examples-file-coding-system)))
+ (setq buffer-file-name file)
+ (save-buffer)))))
+
+(add-hook 'kill-emacs-hook 'mime-save-situation-examples)
+
+(defun mime-reduce-situation-examples (situation-examples)
+ (let ((len (length situation-examples))
+ i ir ic j jr jc ret
+ dest d-i d-j
+ (max-sim 0) sim
+ min-det-ret det-ret
+ min-det-org det-org
+ min-freq freq)
+ (setq i 0
+ ir situation-examples)
+ (while (< i len)
+ (setq ic (car ir)
+ j 0
+ jr situation-examples)
+ (while (< j len)
+ (unless (= i j)
+ (setq jc (car jr))
+ (setq ret (mime-compare-situation-with-example (car ic)(car jc))
+ sim (car ret)
+ det-ret (+ (length (car ic))(length (car jc)))
+ det-org (length (cdr ret))
+ freq (+ (cdr ic)(cdr jc)))
+ (cond ((< max-sim sim)
+ (setq max-sim sim
+ min-det-ret det-ret
+ min-det-org det-org
+ min-freq freq
+ d-i i
+ d-j j
+ dest (cons (cdr ret) freq))
+ )
+ ((= max-sim sim)
+ (cond ((> min-det-ret det-ret)
+ (setq min-det-ret det-ret
+ min-det-org det-org
+ min-freq freq
+ d-i i
+ d-j j
+ dest (cons (cdr ret) freq))
+ )
+ ((= min-det-ret det-ret)
+ (cond ((> min-det-org det-org)
+ (setq min-det-org det-org
+ min-freq freq
+ d-i i
+ d-j j
+ dest (cons (cdr ret) freq))
+ )
+ ((= min-det-org det-org)
+ (cond ((> min-freq freq)
+ (setq min-freq freq
+ d-i i
+ d-j j
+ dest (cons (cdr ret) freq))
+ ))
+ ))
+ ))
+ ))
+ )
+ (setq jr (cdr jr)
+ j (1+ j)))
+ (setq ir (cdr ir)
+ i (1+ i)))
+ (if (> d-i d-j)
+ (setq i d-i
+ d-i d-j
+ d-j i))
+ (setq jr (nthcdr (1- d-j) situation-examples))
+ (setcdr jr (cddr jr))
+ (if (= d-i 0)
+ (setq situation-examples
+ (cdr situation-examples))
+ (setq ir (nthcdr (1- d-i) situation-examples))
+ (setcdr ir (cddr ir))
+ )
+ (if (setq ir (assoc (car dest) situation-examples))
+ (progn
+ (setcdr ir (+ (cdr ir)(cdr dest)))
+ situation-examples)
+ (cons dest situation-examples)
+ ;; situation-examples may be modified.
+ )))
;;; @ presentation of preview
;;; @@@ predicate function
;;;
-(defun mime-view-entity-button-visible-p (entity)
- "Return non-nil if header of ENTITY is visible.
-Please redefine this function if you want to change default setting."
- (let ((media-type (mime-entity-media-type entity))
- (media-subtype (mime-entity-media-subtype entity)))
- (or (not (eq media-type 'application))
- (and (not (eq media-subtype 'x-selection))
- (or (not (eq media-subtype 'octet-stream))
- (let ((mother-entity (mime-entity-parent entity)))
- (or (not (eq (mime-entity-media-type mother-entity)
- 'multipart))
- (not (eq (mime-entity-media-subtype mother-entity)
- 'encrypted)))
- )
- )))))
+;; (defun mime-view-entity-button-visible-p (entity)
+;; "Return non-nil if header of ENTITY is visible.
+;; Please redefine this function if you want to change default setting."
+;; (let ((media-type (mime-entity-media-type entity))
+;; (media-subtype (mime-entity-media-subtype entity)))
+;; (or (not (eq media-type 'application))
+;; (and (not (eq media-subtype 'x-selection))
+;; (or (not (eq media-subtype 'octet-stream))
+;; (let ((mother-entity (mime-entity-parent entity)))
+;; (or (not (eq (mime-entity-media-type mother-entity)
+;; 'multipart))
+;; (not (eq (mime-entity-media-subtype mother-entity)
+;; 'encrypted)))
+;; )
+;; )))))
;;; @@@ entity button generator
;;;
(body . visible)
(body-presentation-method . mime-display-text/richtext)))
+(autoload 'mime-display-application/x-postpet "postpet")
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . application)(subtype . x-postpet)
+ (body . visible)
+ (body-presentation-method . mime-display-application/x-postpet)))
+
(ctree-set-calist-strictly
'mime-preview-condition
'((type . text)(subtype . t)
(body-presentation-method . mime-display-multipart/alternative)))
(ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . partial)
- (body-presentation-method
- . mime-display-message/partial-button)))
+ 'mime-preview-condition
+ '((type . multipart)(subtype . t)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/mixed)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . partial)
+ (body . visible)
+ (body-presentation-method . mime-display-message/partial-button)))
(ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . rfc822)
- (body-presentation-method . nil)
- (childrens-situation (header . visible)
- (entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . rfc822)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/mixed)
+ (childrens-situation (header . visible)
+ (entity-button . invisible))))
(ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . news)
- (body-presentation-method . nil)
- (childrens-situation (header . visible)
- (entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . news)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/mixed)
+ (childrens-situation (header . visible)
+ (entity-button . invisible))))
;;; @@@ entity presentation
(defun mime-display-text/plain (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
- (mime-insert-text-content entity)
+ (condition-case nil
+ (mime-insert-text-content entity)
+ (error (progn
+ (message "Can't decode current entity.")
+ (sit-for 1))))
(run-hooks 'mime-text-decode-hook)
(goto-char (point-max))
(if (not (eq (char-after (1- (point))) ?\n))
(enriched-decode beg (point-max))
)))
+
(defvar mime-view-announcement-for-message/partial
(if (and (>= emacs-major-version 19) window-system)
"\
(mapcar (function
(lambda (child)
(let ((situation
- (or (ctree-match-calist
- mime-preview-condition
- (append (mime-entity-situation child)
- default-situation))
- default-situation)))
+ (mime-find-entity-preview-situation
+ child default-situation)))
(if (cdr (assq 'body-presentation-method situation))
(let ((score
(cdr
(situation (car situations)))
(mime-display-entity child (if (= i p)
situation
- (del-alist 'body-presentation-method
- (copy-alist situation))))
- )
+ (put-alist 'body 'invisible
+ (copy-alist situation)))))
(setq children (cdr children)
situations (cdr situations)
- i (1+ i))
- )))
+ i (1+ i)))))
;;; @ acting-condition
(or preview-buffer
(setq preview-buffer (current-buffer)))
(let* (e nb ne nhb nbb)
- (mime-goto-header-start-point entity)
(in-calist-package 'mime-view)
(or situation
(setq situation
- (or (ctree-match-calist mime-preview-condition
- (append (mime-entity-situation entity)
- default-situation))
- default-situation)))
+ (mime-find-entity-preview-situation entity default-situation)))
(let ((button-is-invisible
- (eq (cdr (assq 'entity-button situation)) 'invisible))
+ (eq (cdr (or (assq '*entity-button situation)
+ (assq 'entity-button situation)))
+ 'invisible))
(header-is-visible
- (eq (cdr (assq 'header situation)) 'visible))
- (header-presentation-method
- (or (cdr (assq 'header-presentation-method situation))
- (cdr (assq (cdr (assq 'major-mode situation))
- mime-header-presentation-method-alist))))
- (body-presentation-method
- (cdr (assq 'body-presentation-method situation)))
+ (eq (cdr (or (assq '*header situation)
+ (assq 'header situation)))
+ 'visible))
+ (body-is-visible
+ (eq (cdr (or (assq '*body situation)
+ (assq 'body situation)))
+ 'visible))
(children (mime-entity-children entity)))
(set-buffer preview-buffer)
(setq nb (point))
(narrow-to-region nb nb)
(or button-is-invisible
- (if (mime-view-entity-button-visible-p entity)
- (mime-view-insert-entity-button entity)
- ))
- (when header-is-visible
- (setq nhb (point))
- (if header-presentation-method
- (funcall header-presentation-method entity situation)
- (mime-insert-header entity
- mime-view-ignored-field-list
- mime-view-visible-field-list))
- (run-hooks 'mime-display-header-hook)
- (put-text-property nhb (point-max) 'mime-view-entity-header entity)
- (goto-char (point-max))
- (insert "\n")
- )
+ ;; (if (mime-view-entity-button-visible-p entity)
+ (mime-view-insert-entity-button entity)
+ ;; )
+ )
+ (if header-is-visible
+ (let ((header-presentation-method
+ (or (cdr (assq 'header-presentation-method situation))
+ (cdr (assq (cdr (assq 'major-mode situation))
+ mime-header-presentation-method-alist)))))
+ (setq nhb (point))
+ (if header-presentation-method
+ (funcall header-presentation-method entity situation)
+ (mime-insert-header entity
+ mime-view-ignored-field-list
+ mime-view-visible-field-list))
+ (run-hooks 'mime-display-header-hook)
+ (put-text-property nhb (point-max) 'mime-view-entity-header entity)
+ (goto-char (point-max))
+ (insert "\n")))
(setq nbb (point))
- (cond (children)
- ((functionp body-presentation-method)
- (funcall body-presentation-method entity situation)
- )
- (t
- (when button-is-invisible
- (goto-char (point-max))
- (mime-view-insert-entity-button entity)
- )
- (or header-is-visible
- (progn
- (goto-char (point-max))
- (insert "\n")
- ))
- ))
+ (unless children
+ (if body-is-visible
+ (let ((body-presentation-method
+ (cdr (assq 'body-presentation-method situation))))
+ (if (functionp body-presentation-method)
+ (funcall body-presentation-method entity situation)
+ (mime-display-text/plain entity situation)))
+ (when button-is-invisible
+ (goto-char (point-max))
+ (mime-view-insert-entity-button entity)
+ )
+ (unless header-is-visible
+ (goto-char (point-max))
+ (insert "\n"))
+ ))
(setq ne (point-max))
(widen)
(put-text-property nb ne 'mime-view-entity entity)
(put-text-property nb ne 'mime-view-situation situation)
(put-text-property nbb ne 'mime-view-entity-body entity)
(goto-char ne)
- (if children
- (if (functionp body-presentation-method)
- (funcall body-presentation-method entity situation)
- (mime-display-multipart/mixed entity situation)
- ))
+ (if (and children body-is-visible)
+ (let ((body-presentation-method
+ (cdr (assq 'body-presentation-method situation))))
+ (if (functionp body-presentation-method)
+ (funcall body-presentation-method entity situation)
+ (mime-display-multipart/mixed entity situation))))
)))
(defvar mouse-button-2 'button2)
)
(t
+ (defvar mime-view-popup-menu
+ (let ((menu (make-sparse-keymap mime-view-menu-title)))
+ (nconc menu
+ (mapcar (function
+ (lambda (item)
+ (list (intern (nth 1 item)) 'menu-item
+ (nth 1 item)(nth 2 item))
+ ))
+ mime-view-menu-list))))
+ (defun mime-view-popup-menu (event)
+ "Popup the menu in the MIME Viewer buffer"
+ (interactive "@e")
+ (let ((menu mime-view-popup-menu) events func)
+ (setq events (x-popup-menu t menu))
+ (and events
+ (setq func (lookup-key menu (apply #'vector events)))
+ (commandp func)
+ (funcall func))))
(defvar mouse-button-2 [mouse-2])
))
"e" (function mime-preview-extract-current-entity))
(define-key mime-view-mode-map
"\C-c\C-p" (function mime-preview-print-current-entity))
+
+ (define-key mime-view-mode-map
+ "\C-c\C-t\C-f" (function mime-preview-toggle-header))
+ (define-key mime-view-mode-map
+ "\C-c\C-th" (function mime-preview-toggle-header))
+ (define-key mime-view-mode-map
+ "\C-c\C-t\C-c" (function mime-preview-toggle-content))
+
+ (define-key mime-view-mode-map
+ "\C-c\C-v\C-f" (function mime-preview-show-header))
+ (define-key mime-view-mode-map
+ "\C-c\C-vh" (function mime-preview-show-header))
+ (define-key mime-view-mode-map
+ "\C-c\C-v\C-c" (function mime-preview-show-content))
+
+ (define-key mime-view-mode-map
+ "\C-c\C-d\C-f" (function mime-preview-hide-header))
+ (define-key mime-view-mode-map
+ "\C-c\C-dh" (function mime-preview-hide-header))
+ (define-key mime-view-mode-map
+ "\C-c\C-d\C-c" (function mime-preview-hide-content))
+
(define-key mime-view-mode-map
"a" (function mime-preview-follow-current-entity))
(define-key mime-view-mode-map
mouse-button-3 (function mime-view-xemacs-popup-menu))
)
((>= emacs-major-version 19)
+ (define-key mime-view-mode-map
+ mouse-button-3 (function mime-view-popup-menu))
(define-key mime-view-mode-map [menu-bar mime-view]
(cons mime-view-menu-title
(make-sparse-keymap mime-view-menu-title)))
(setq preview-buffer
(concat "*Preview-" (mime-entity-name message) "*")))
(or original-major-mode
- (setq original-major-mode
- (with-current-buffer (mime-entity-header-buffer message)
- major-mode)))
+ (setq original-major-mode major-mode))
(let ((inhibit-read-only t))
(set-buffer (get-buffer-create preview-buffer))
(widen)
)
(setq mime-message-structure (mime-open-entity type raw-buffer))
(or (mime-entity-content-type mime-message-structure)
- (mime-entity-set-content-type-internal
- mime-message-structure ctl))
+ (mime-entity-set-content-type mime-message-structure ctl))
)
(or (mime-entity-encoding mime-message-structure)
- (mime-entity-set-encoding-internal mime-message-structure encoding))
+ (mime-entity-set-encoding mime-message-structure encoding))
))
(mime-display-message mime-message-structure preview-buffer
mother default-keymap-or-function)
)
+;;; @@ utility
+;;;
+
+(defun mime-preview-find-boundary-info (&optional get-mother)
+ (let (entity
+ p-beg p-end
+ entity-node-id len)
+ (while (null (setq entity
+ (get-text-property (point) 'mime-view-entity)))
+ (backward-char))
+ (setq p-beg (previous-single-property-change (point) 'mime-view-entity))
+ (setq entity-node-id (mime-entity-node-id entity))
+ (setq len (length entity-node-id))
+ (cond ((null p-beg)
+ (setq p-beg
+ (if (eq (next-single-property-change (point-min)
+ 'mime-view-entity)
+ (point))
+ (point)
+ (point-min)))
+ )
+ ((eq (next-single-property-change p-beg 'mime-view-entity)
+ (point))
+ (setq p-beg (point))
+ ))
+ (setq p-end (next-single-property-change p-beg 'mime-view-entity))
+ (cond ((null p-end)
+ (setq p-end (point-max))
+ )
+ ((null entity-node-id)
+ (setq p-end (point-max))
+ )
+ (get-mother
+ (save-excursion
+ (goto-char p-end)
+ (catch 'tag
+ (let (e i)
+ (while (setq e
+ (next-single-property-change
+ (point) 'mime-view-entity))
+ (goto-char e)
+ (let ((rc (mime-entity-node-id
+ (get-text-property (1- (point))
+ 'mime-view-entity))))
+ (or (and (>= (setq i (- (length rc) len)) 0)
+ (equal entity-node-id (nthcdr i rc)))
+ (throw 'tag nil)))
+ (setq p-end e)))
+ (setq p-end (point-max))))
+ ))
+ (vector p-beg p-end entity)))
+
+
;;; @@ playing
;;;
It calls following-method selected from variable
`mime-preview-following-method-alist'."
(interactive)
- (let (entity)
- (while (null (setq entity
- (get-text-property (point) 'mime-view-entity)))
- (backward-char)
- )
- (let* ((p-beg
- (previous-single-property-change (point) 'mime-view-entity))
- p-end
- ph-end
+ (let ((entity (mime-preview-find-boundary-info t))
+ p-beg p-end
+ pb-beg)
+ (setq p-beg (aref entity 0)
+ p-end (aref entity 1)
+ entity (aref entity 2))
+ (if (get-text-property p-beg 'mime-view-entity-body)
+ (setq pb-beg p-beg)
+ (setq pb-beg
+ (next-single-property-change
+ p-beg 'mime-view-entity-body nil
+ (or (next-single-property-change p-beg 'mime-view-entity)
+ p-end))))
+ (let* ((mode (mime-preview-original-major-mode 'recursive))
(entity-node-id (mime-entity-node-id entity))
- (len (length entity-node-id))
- )
- (cond ((null p-beg)
- (setq p-beg
- (if (eq (next-single-property-change (point-min)
- 'mime-view-entity)
- (point))
- (point)
- (point-min)))
- )
- ((eq (next-single-property-change p-beg 'mime-view-entity)
- (point))
- (setq p-beg (point))
- ))
- (setq p-end (next-single-property-change p-beg 'mime-view-entity))
- (cond ((null p-end)
- (setq p-end (point-max))
- )
- ((null entity-node-id)
- (setq p-end (point-max))
- )
- (t
- (save-excursion
- (goto-char p-end)
- (catch 'tag
- (let (e)
- (while (setq e
- (next-single-property-change
- (point) 'mime-view-entity))
- (goto-char e)
- (let ((rc (mime-entity-node-id
- (get-text-property (point)
- 'mime-view-entity))))
- (or (equal entity-node-id
- (nthcdr (- (length rc) len) rc))
- (throw 'tag nil)
- ))
- (setq p-end e)
- ))
- (setq p-end (point-max))
- ))
- ))
- (setq ph-end
- (previous-single-property-change p-end 'mime-view-entity-header))
- (if (or (null ph-end)
- (< ph-end p-beg))
- (setq ph-end p-beg)
- )
- (let* ((mode (mime-preview-original-major-mode 'recursive))
- (new-name
- (format "%s-%s" (buffer-name) (reverse entity-node-id)))
- new-buf
- (the-buf (current-buffer))
- fields)
- (save-excursion
- (set-buffer (setq new-buf (get-buffer-create new-name)))
- (erase-buffer)
- (insert-buffer-substring the-buf ph-end p-end)
- (when (= ph-end p-beg)
- (goto-char (point-min))
- (insert ?\n))
- (goto-char (point-min))
- (let ((current-entity
- (if (and (eq (mime-entity-media-type entity) 'message)
- (eq (mime-entity-media-subtype entity) 'rfc822))
- (mime-entity-children entity)
- entity))
- str)
- (while (and current-entity
- (progn
- (setq str
- (with-current-buffer
- (mime-entity-header-buffer current-entity)
- (save-restriction
- (narrow-to-region
- (mime-entity-header-start-point
- current-entity)
- (mime-entity-header-end-point
- current-entity))
- (std11-header-string-except
- (concat
- "^"
- (apply (function regexp-or) fields)
- ":") ""))))
- (if (and (eq (mime-entity-media-type
- current-entity) 'message)
- (eq (mime-entity-media-subtype
- current-entity) 'rfc822))
- nil
- (if str
- (insert str)
- )
- t)))
- (setq fields (std11-collect-field-names)
- current-entity (mime-entity-parent current-entity))
- )
- )
- (let ((rest mime-view-following-required-fields-list)
- field-name ret)
- (while rest
- (setq field-name (car rest))
- (or (std11-field-body field-name)
- (progn
- (save-excursion
- (set-buffer the-buf)
- (setq ret
- (when mime-mother-buffer
- (set-buffer mime-mother-buffer)
- (mime-entity-fetch-field
- (get-text-property (point)
- 'mime-view-entity)
- field-name))))
- (if ret
- (insert (concat field-name ": " ret "\n"))
- )))
- (setq rest (cdr rest))
- ))
- (mime-decode-header-in-buffer)
- )
- (let ((f (cdr (assq mode mime-preview-following-method-alist))))
- (if (functionp f)
- (funcall f new-buf)
- (message
- (format
- "Sorry, following method for %s is not implemented yet."
- mode))
+ (new-name
+ (format "%s-%s" (buffer-name) (reverse entity-node-id)))
+ new-buf
+ (the-buf (current-buffer))
+ fields)
+ (save-excursion
+ (set-buffer (setq new-buf (get-buffer-create new-name)))
+ (erase-buffer)
+ (insert ?\n)
+ (insert-buffer-substring the-buf pb-beg p-end)
+ (goto-char (point-min))
+ (let ((current-entity
+ (if (and (eq (mime-entity-media-type entity) 'message)
+ (eq (mime-entity-media-subtype entity) 'rfc822))
+ (car (mime-entity-children entity))
+ entity)))
+ (while (and current-entity
+ (if (and (eq (mime-entity-media-type
+ current-entity) 'message)
+ (eq (mime-entity-media-subtype
+ current-entity) 'rfc822))
+ nil
+ (mime-insert-header current-entity fields)
+ t))
+ (setq fields (std11-collect-field-names)
+ current-entity (mime-entity-parent current-entity))
))
- ))))
+ (let ((rest mime-view-following-required-fields-list)
+ field-name ret)
+ (while rest
+ (setq field-name (car rest))
+ (or (std11-field-body field-name)
+ (progn
+ (save-excursion
+ (set-buffer the-buf)
+ (let ((entity (when mime-mother-buffer
+ (set-buffer mime-mother-buffer)
+ (get-text-property (point)
+ 'mime-view-entity))))
+ (while (and entity
+ (null (setq ret (mime-entity-fetch-field
+ entity field-name))))
+ (setq entity (mime-entity-parent entity)))))
+ (if ret
+ (insert (concat field-name ": " ret "\n"))
+ )))
+ (setq rest (cdr rest))
+ ))
+ )
+ (let ((f (cdr (assq mode mime-preview-following-method-alist))))
+ (if (functionp f)
+ (funcall f new-buf)
+ (message
+ (format
+ "Sorry, following method for %s is not implemented yet."
+ mode))
+ ))
+ )))
;;; @@ moving
(mime-preview-scroll-down-entity (or lines 1))
)
+
+;;; @@ display
+;;;
+
+(defun mime-preview-toggle-display (type &optional display)
+ (let ((situation (mime-preview-find-boundary-info))
+ (sym (intern (concat "*" (symbol-name type))))
+ entity p-beg p-end)
+ (setq p-beg (aref situation 0)
+ p-end (aref situation 1)
+ entity (aref situation 2)
+ situation (get-text-property p-beg 'mime-view-situation))
+ (cond ((eq display 'invisible)
+ (setq display nil))
+ (display)
+ (t
+ (setq display
+ (eq (cdr (or (assq sym situation)
+ (assq type situation)))
+ 'invisible))))
+ (setq situation (put-alist sym (if display
+ 'visible
+ 'invisible)
+ situation))
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (delete-region p-beg p-end)
+ (mime-display-entity entity situation)))
+ (let ((ret (assoc situation mime-preview-situation-example-list)))
+ (if ret
+ (setcdr ret (1+ (cdr ret)))
+ (add-to-list 'mime-preview-situation-example-list
+ (cons situation 0))))))
+
+(defun mime-preview-toggle-header (&optional force-visible)
+ (interactive "P")
+ (mime-preview-toggle-display 'header force-visible))
+
+(defun mime-preview-toggle-content (&optional force-visible)
+ (interactive "P")
+ (mime-preview-toggle-display 'body force-visible))
+
+(defun mime-preview-show-header ()
+ (interactive)
+ (mime-preview-toggle-display 'header 'visible))
+
+(defun mime-preview-show-content ()
+ (interactive)
+ (mime-preview-toggle-display 'body 'visible))
+
+(defun mime-preview-hide-header ()
+ (interactive)
+ (mime-preview-toggle-display 'header 'invisible))
+
+(defun mime-preview-hide-content ()
+ (interactive)
+ (mime-preview-toggle-display 'body 'invisible))
+
+
;;; @@ quitting
;;;
(provide 'mime-view)
-(run-hooks 'mime-view-load-hook)
+(let ((file mime-situation-examples-file))
+ (if (file-readable-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (setq mime-situation-examples-file-coding-system
+ (static-cond
+ ((boundp 'buffer-file-coding-system)
+ (symbol-value 'buffer-file-coding-system))
+ ((boundp 'file-coding-system)
+ (symbol-value 'file-coding-system))
+ (t nil)))
+ (eval-buffer)
+ ;; format check
+ (condition-case nil
+ (let ((i 0))
+ (while (and (> (length mime-preview-situation-example-list)
+ mime-preview-situation-example-list-max-size)
+ (< i 16))
+ (setq mime-preview-situation-example-list
+ (mime-reduce-situation-examples
+ mime-preview-situation-example-list))
+ (setq i (1+ i))))
+ (error (setq mime-preview-situation-example-list nil)))
+ ;; (let ((rest mime-preview-situation-example-list))
+ ;; (while rest
+ ;; (ctree-set-calist-strictly 'mime-preview-condition
+ ;; (caar rest))
+ ;; (setq rest (cdr rest))))
+ (condition-case nil
+ (let ((i 0))
+ (while (and (> (length mime-acting-situation-example-list)
+ mime-acting-situation-example-list-max-size)
+ (< i 16))
+ (setq mime-acting-situation-example-list
+ (mime-reduce-situation-examples
+ mime-acting-situation-example-list))
+ (setq i (1+ i))))
+ (error (setq mime-acting-situation-example-list nil))))))
;;; mime-view.el ends here
;;; mime-w3.el --- mime-view content filter for text
-;; Copyright (C) 1994,1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: HTML, MIME, multimedia, mail, news
;; This file is part of SEMI (Suite of Emacs MIME Interfaces).
(defvar mime-w3-message-structure nil)
(defun mime-preview-text/html (entity situation)
- (setq mime-w3-message-structure
- (with-current-buffer (mime-entity-buffer entity)
- mime-message-structure))
+ (setq mime-w3-message-structure (mime-find-root-entity entity))
(goto-char (point-max))
(let ((p (point)))
(insert "\n")
--- /dev/null
+;;; pgg-def.el --- functions/macros for defining PGG functions
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'pcustom)
+
+(defgroup pgg ()
+ "Glue for the various PGP implementations."
+ :group 'mime)
+
+(defcustom pgg-default-scheme 'gpg
+ "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."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-default-keyserver-address "wwwkeys.pgp.net"
+ "Host name of keyserver."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-encrypt-for-me nil
+ "If t, encrypt all outgoing messages with user's public key."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-cache-passphrase t
+ "If t, cache passphrase."
+ :group 'pgg
+ :type 'boolean)
+
+(defvar pgg-status-buffer " *PGG status*")
+(defvar pgg-errors-buffer " *PGG errors*")
+(defvar pgg-output-buffer " *PGG output*")
+
+(defvar pgg-echo-buffer "*PGG-echo*")
+
+(defvar pgg-scheme nil
+ "Current scheme of PGP implementation.")
+
+(defmacro pgg-truncate-key-identifier (key)
+ `(if (> (length ,key) 8) (substring ,key 8) ,key))
+
+(provide 'pgg-def)
+
+;;; pgg-def.el ends here
--- /dev/null
+;;; pgg-gpg.el --- GnuPG support for PGG.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-gpg ()
+ "GnuPG interface"
+ :group 'pgg)
+
+(defcustom pgg-gpg-program "gpg"
+ "The GnuPG executable."
+ :group 'pgg-gpg
+ :type 'string)
+
+(defcustom pgg-gpg-extra-args nil
+ "Extra arguments for every GnuPG invocation."
+ :group 'pgg-gpg
+ :type 'string)
+
+(eval-and-compile
+ (luna-define-class pgg-scheme-gpg (pgg-scheme)))
+
+(defvar pgg-gpg-user-id nil
+ "GnuPG ID of your default identity.")
+
+(defvar pgg-scheme-gpg-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-gpg ()
+ (or pgg-scheme-gpg-instance
+ (setq pgg-scheme-gpg-instance
+ (luna-make-entity 'pgg-scheme-gpg))))
+
+(defun pgg-gpg-process-region (start end passphrase program args)
+ (let* ((output-file-name
+ (concat temporary-file-directory (make-temp-name "pgg-output")))
+ (args
+ `("--status-fd" "2"
+ ,@(if passphrase '("--passphrase-fd" "0"))
+ "--output" ,output-file-name
+ ,@pgg-gpg-extra-args ,@args))
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (orig-mode (default-file-modes))
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create errors-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (as-binary-output-file
+ (setq process
+ (apply #'start-process "*GnuPG*" errors-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 (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (if (file-exists-p output-file-name)
+ (insert-file-contents-as-raw-text-CRLF output-file-name))
+ (set-buffer errors-buffer)
+ (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 (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (if (file-exists-p output-file-name)
+ (delete-file output-file-name))
+ (set-default-file-modes orig-mode))))
+
+(defun pgg-gpg-possibly-cache-passphrase (passphrase)
+ (if (and pgg-cache-passphrase
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] GOOD_PASSPHRASE\\>" nil t)))
+ (pgg-add-passphrase-cache
+ (progn
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t)
+ (substring (match-string 0) -8)))
+ passphrase)))
+
+(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-gpg)
+ string &optional type)
+ (let ((args (list "--with-colons" "--no-greeting" "--batch"
+ (if type "--list-secret-keys" "--list-keys")
+ string)))
+ (with-temp-buffer
+ (apply #'call-process pgg-gpg-program nil t nil args)
+ (goto-char (point-min))
+ (if (re-search-forward "^\\(sec\\|pub\\):" nil t)
+ (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)
+ start end recipients)
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (args
+ `("--batch" "--armor" "--always-trust" "--encrypt"
+ ,@(if recipients
+ (apply #'nconc
+ (mapcar (lambda (rcpt)
+ (list "--remote-user" rcpt))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-gpg-user-id)))))))))
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end nil pgg-gpg-program args))
+ (pgg-process-when-success)))
+
+(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
+ (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)
+ (with-current-buffer pgg-errors-buffer
+ (pgg-gpg-possibly-cache-passphrase passphrase)
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
+
+(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
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'sign)))
+ (args
+ (list (if cleartext "--clearsign" "--detach-sign")
+ "--armor" "--batch" "--verbose"
+ "--local-user" pgg-gpg-user-id))
+ (inhibit-read-only t)
+ buffer-read-only)
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+ (with-current-buffer pgg-errors-buffer
+ (pgg-gpg-possibly-cache-passphrase passphrase))
+ (pgg-process-when-success)))
+
+(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-gpg)
+ start end &optional signature)
+ (let ((args '("--batch" "--verify")))
+ (when (stringp signature)
+ (setq args (append args (list signature))))
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^gpg: " nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (prog1 (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t)
+ (goto-char (point-min))
+ (delete-matching-lines "^warning\\|\\[GNUPG:]")
+ (set-buffer pgg-output-buffer)
+ (insert-buffer-substring pgg-errors-buffer)))))
+
+(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"
+ pgg-gpg-user-id)))
+ (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-gpg)
+ start end)
+ (let ((args '("--import" "--batch" "-")) status)
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (set-buffer pgg-errors-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)(point)))
+ status (vconcat (mapcar #'string-to-int (split-string status))))
+ (erase-buffer)
+ (insert (format "Imported %d key(s).
+\tArmor contains %d key(s) [%d bad, %d old].\n"
+ (+ (aref status 2)
+ (aref status 10))
+ (aref status 0)
+ (aref status 1)
+ (+ (aref status 4)
+ (aref status 11)))
+ (if (zerop (aref status 9))
+ ""
+ "\tSecret keys are imported.\n")))
+ (append-to-buffer pgg-output-buffer (point-min)(point-max))
+ (pgg-process-when-success)))
+
+(provide 'pgg-gpg)
+
+;;; pgg-gpg.el ends here
--- /dev/null
+;;; pgg-parse.el --- OpenPGP packet parsing
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module is based on
+
+;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
+;; 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)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(eval-when-compile (require 'static))
+
+(require 'poem)
+(require 'pccl)
+(require 'pcustom)
+(require 'mel)
+
+(defgroup pgg-parse ()
+ "OpenPGP packet parsing"
+ :group 'pgg)
+
+(defcustom pgg-parse-public-key-algorithm-alist
+ '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
+ "Alist of the assigned number to the public key algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-symmetric-key-algorithm-alist
+ '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
+ "Alist of the assigned number to the simmetric key algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-hash-algorithm-alist
+ '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
+ "Alist of the assigned number to the cryptographic hash algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-compression-algorithm-alist
+ '((0 . nil); Uncompressed
+ (1 . ZIP)
+ (2 . ZLIB))
+ "Alist of the assigned number to the compression algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-signature-type-alist
+ '((0 . "Signature of a binary document")
+ (1 . "Signature of a canonical text document")
+ (2 . "Standalone signature")
+ (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")
+ (24 . "Subkey Binding Signature")
+ (31 . "Signature directly on a key")
+ (32 . "Key revocation signature")
+ (40 . "Subkey revocation signature")
+ (48 . "Certification revocation signature")
+ (64 . "Timestamp signature."))
+ "Alist of the assigned number to the signature type."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-ignore-packet-checksum t; XXX
+ "If non-nil checksum of each ascii armored packet will be ignored."
+ :group 'pgg-parse
+ :type 'boolean)
+
+(defvar pgg-armor-header-lines
+ '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP SIGNATURE-----\r?$")
+ "Armor headers.")
+
+(defmacro pgg-format-key-identifier (string)
+ `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
+ (string-to-int-list ,string))))
+
+(defmacro pgg-parse-time-field (bytes)
+ `(list (logior (lsh (car ,bytes) 8)
+ (nth 1 ,bytes))
+ (logior (lsh (nth 2 ,bytes) 8)
+ (nth 3 ,bytes))
+ 0))
+
+(defmacro pgg-byte-after (&optional pos)
+ `(char-int (char-after ,(or pos `(point)))))
+
+(defmacro pgg-read-byte ()
+ `(char-int (char-after (prog1 (point) (forward-char)))))
+
+(defmacro pgg-read-bytes-string (nbytes)
+ `(buffer-substring
+ (point) (prog1 (+ ,nbytes (point))
+ (forward-char ,nbytes))))
+
+(defmacro pgg-read-bytes (nbytes)
+ `(string-to-int-list (pgg-read-bytes-string ,nbytes)))
+
+(defmacro pgg-read-body-string (ptag)
+ `(if (nth 1 ,ptag)
+ (pgg-read-bytes-string (nth 1 ,ptag))
+ (pgg-read-bytes-string (- (point-max) (point)))))
+
+(defmacro pgg-read-body (ptag)
+ `(string-to-int-list (pgg-read-body-string ,ptag)))
+
+(defalias 'pgg-skip-bytes 'forward-char)
+
+(defmacro pgg-skip-header (ptag)
+ `(pgg-skip-bytes (nth 2 ,ptag)))
+
+(defmacro pgg-skip-body (ptag)
+ `(pgg-skip-bytes (nth 1 ,ptag)))
+
+(defmacro pgg-set-alist (alist key value)
+ `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
+
+(unless-broken ccl-usable
+ (define-ccl-program pgg-parse-crc24
+ '(1
+ ((loop
+ (read r0) (r1 ^= r0) (r2 ^= 0)
+ (r5 = 0)
+ (loop
+ (r1 <<= 1)
+ (r1 += ((r2 >> 15) & 1))
+ (r2 <<= 1)
+ (if (r1 & 256)
+ ((r1 ^= 390) (r2 ^= 19707)))
+ (if (r5 < 7)
+ ((r5 += 1)
+ (repeat))))
+ (repeat)))))
+
+ (defun pgg-parse-crc24-string (string)
+ (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
+ (ccl-execute-on-string pgg-parse-crc24 h string)
+ (format "%c%c%c"
+ (logand (aref h 1) 255)
+ (logand (lsh (aref h 2) -8) 255)
+ (logand (aref h 2) 255)))))
+
+(defmacro pgg-parse-length-type (c)
+ `(cond
+ ((< ,c 192) (cons ,c 1))
+ ((< ,c 224)
+ (cons (+ (lsh (- ,c 192) 8)
+ (pgg-byte-after (+ 2 (point)))
+ 192)
+ 2))
+ ((= ,c 255)
+ (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
+ (pgg-byte-after (+ 3 (point))))
+ (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
+ (pgg-byte-after (+ 5 (point)))))
+ 5))
+ (t;partial body length
+ '(0 . 0))))
+
+(defun pgg-parse-packet-header ()
+ (let ((ptag (pgg-byte-after))
+ length-type content-tag packet-bytes header-bytes)
+ (if (zerop (logand 64 ptag));Old format
+ (progn
+ (setq length-type (logand ptag 3)
+ length-type (if (= 3 length-type) 0 (lsh 1 length-type))
+ content-tag (logand 15 (lsh ptag -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 content-tag (logand 63 ptag)
+ length-type (pgg-parse-length-type
+ (pgg-byte-after (1+ (point))))
+ packet-bytes (car length-type)
+ header-bytes (1+ (cdr length-type))))
+ (list content-tag packet-bytes header-bytes)))
+
+(defun pgg-parse-packet (ptag)
+ (case (car ptag)
+ (1 ;Public-Key Encrypted Session Key Packet
+ (pgg-parse-public-key-encrypted-session-key-packet ptag))
+ (2 ;Signature Packet
+ (pgg-parse-signature-packet ptag))
+ (3 ;Symmetric-Key Encrypted Session Key Packet
+ (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
+ ;; 4 -- One-Pass Signature Packet
+ ;; 5 -- Secret Key Packet
+ (6 ;Public Key Packet
+ (pgg-parse-public-key-packet ptag))
+ ;; 7 -- Secret Subkey Packet
+ ;; 8 -- Compressed Data Packet
+ (9 ;Symmetrically Encrypted Data Packet
+ (pgg-read-body-string ptag))
+ (10 ;Marker Packet
+ (pgg-read-body-string ptag))
+ (11 ;Literal Data Packet
+ (pgg-read-body-string ptag))
+ ;; 12 -- Trust Packet
+ (13 ;User ID Packet
+ (pgg-read-body-string ptag))
+ ;; 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
+ (function pgg-parse-packet-header)))
+ (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
+ (funcall body-parser ptag)))
+ result)
+ (if (zerop (nth 1 ptag))
+ (goto-char (point-max))
+ (forward-char (nth 1 ptag))))
+ result))
+
+(defun pgg-parse-signature-subpacket-header ()
+ (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
+ (list (pgg-byte-after (+ (cdr length-type) (point)))
+ (1- (car length-type))
+ (1+ (cdr length-type)))))
+
+(defun pgg-parse-signature-subpacket (ptag)
+ (case (car ptag)
+ (2 ;signature creation time
+ (cons 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (3 ;signature expiration time
+ (cons 'signature-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (4 ;exportable certification
+ (cons 'exportability (pgg-read-byte)))
+ (5 ;trust signature
+ (cons 'trust-level (pgg-read-byte)))
+ (6 ;regular expression
+ (cons 'regular-expression
+ (pgg-read-body-string ptag)))
+ (7 ;revocable
+ (cons 'revocability (pgg-read-byte)))
+ (9 ;key expiration time
+ (cons 'key-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ ;; 10 = placeholder for backward compatibility
+ (11 ;preferred symmetric algorithms
+ (cons 'preferred-symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist))))
+ (12 ;revocation key
+ )
+ (16 ;issuer key ID
+ (cons 'key-identifier
+ (pgg-format-key-identifier (pgg-read-body-string ptag))))
+ (20 ;notation data
+ (pgg-skip-bytes 4)
+ (cons 'notation
+ (let ((name-bytes (pgg-read-bytes 2))
+ (value-bytes (pgg-read-bytes 2)))
+ (cons (pgg-read-bytes-string
+ (logior (lsh (car name-bytes) 8)
+ (nth 1 name-bytes)))
+ (pgg-read-bytes-string
+ (logior (lsh (car value-bytes) 8)
+ (nth 1 value-bytes)))))))
+ (21 ;preferred hash algorithms
+ (cons 'preferred-hash-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-hash-algorithm-alist))))
+ (22 ;preferred compression algorithms
+ (cons 'preferred-compression-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-compression-algorithm-alist))))
+ (23 ;key server preferences
+ (cons 'key-server-preferences
+ (pgg-read-body ptag)))
+ (24 ;preferred key server
+ (cons 'preferred-key-server
+ (pgg-read-body-string ptag)))
+ ;; 25 = primary user id
+ (26 ;policy URL
+ (cons 'policy-url (pgg-read-body-string ptag)))
+ ;; 27 = key flags
+ ;; 28 = signer's user id
+ ;; 29 = reason for revocation
+ ;; 100 to 110 = internal or user-defined
+ ))
+
+(defun pgg-parse-signature-packet (ptag)
+ (let* ((signature-version (pgg-byte-after))
+ (result (list (cons 'version signature-version)))
+ hashed-material field n)
+ (cond
+ ((= signature-version 3)
+ (pgg-skip-bytes 2)
+ (setq hashed-material (pgg-read-bytes 5))
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pop hashed-material)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'creation-time
+ (pgg-parse-time-field hashed-material))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte)))
+ ((= signature-version 4)
+ (pgg-skip-bytes 1)
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))
+ (goto-char (point-max))))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ (setcdr (setq field (assq 'hash-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-hash-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version (pgg-read-byte))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-packet (ptag)
+ (let* ((key-version (pgg-read-byte))
+ (result (list (cons 'version key-version)))
+ field)
+ (cond
+ ((= 3 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'key-expiry (pgg-read-bytes 2))
+ (pgg-set-alist result
+ '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))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-decode-packets ()
+ (let* ((marker
+ (set-marker (make-marker)
+ (and (re-search-forward "^=")
+ (match-beginning 0))))
+ (checksum (buffer-substring (point) (+ 4 (point)))))
+ (delete-region marker (point-max))
+ (mime-decode-region (point-min) marker "base64")
+ (static-when (fboundp 'pgg-parse-crc24-string )
+ (or pgg-ignore-packet-checksum
+ (string-equal
+ (funcall (mel-find-function 'mime-encode-string "base64")
+ (pgg-parse-crc24-string
+ (buffer-substring (point-min)(point-max))))
+ checksum)
+ (error "PGP packet checksum does not match")))))
+
+(defun pgg-decode-armor-region (start end)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP" nil t)
+ (delete-region (point-min)
+ (and (search-forward "\n\n")
+ (match-end 0)))
+ (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets)))
+
+(defun pgg-parse-armor (string)
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (set-buffer-multibyte nil)
+ (insert string)
+ (pgg-decode-armor-region (point-min)(point))))
+
+(defun pgg-parse-armor-region (start end)
+ (pgg-parse-armor (string-as-unibyte (buffer-substring start end))))
+
+(provide 'pgg-parse)
+
+;;; pgg-parse.el ends here
--- /dev/null
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp ()
+ "PGP 2.* and 6.* interface"
+ :group 'pgg)
+
+(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>\"."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-extra-args nil
+ "Extra arguments for every PGP invocation."
+ :group 'pgg-pgp
+ :type 'string)
+
+(eval-and-compile
+ (luna-define-class pgg-scheme-pgp (pgg-scheme)))
+
+(defvar pgg-pgp-user-id nil
+ "PGP ID of your default identity.")
+
+(defvar pgg-scheme-pgp-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-pgp ()
+ (or pgg-scheme-pgp-instance
+ (setq pgg-scheme-pgp-instance
+ (luna-make-entity 'pgg-scheme-pgp))))
+
+(defun pgg-pgp-process-region (start end passphrase program args)
+ (let* ((errors-file-name
+ (concat temporary-file-directory
+ (make-temp-name "pgg-errors")))
+ (args
+ (append args
+ pgg-pgp-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp-shell-file-name)
+ (shell-command-switch pgg-pgp-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (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))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(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-disable-undo)
+ (erase-buffer)
+ (apply #'call-process pgg-pgp-program nil t nil args)
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
+ (buffer-substring (point)(+ 8 (point))))
+ ((re-search-forward "^Type" nil t);PGP 6.*
+ (beginning-of-line 2)
+ (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)
+ start end recipients)
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (args
+ `("+encrypttoself=off +verbose=1" "+batchmode"
+ "+language=us" "-fate"
+ ,@(if recipients
+ (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-pgp-user-id))))))))
+ (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)
+ start end)
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-scheme-lookup-key scheme pgg-pgp-user-id 'encrypt)))
+ (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)
+ start end &optional clearsign)
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-scheme-lookup-key scheme pgg-pgp-user-id 'sign)))
+ (args
+ (list (if clearsign "-fast" "-fbast")
+ "+verbose=1" "+language=us" "+batchmode"
+ "-u" pgg-pgp-user-id)))
+ (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+ (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
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(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))
+ (args '("+verbose=1" "+batchmode" "+language=us"))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (write-region-as-binary start end orig-file))
+ (set-default-file-modes orig-mode))
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature orig-file))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (pgg-process-when-success
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while (re-search-forward "^warning: " nil t)
+ (delete-region (match-beginning 0)
+ (progn (beginning-of-line 2) (point)))))
+ (goto-char (point-min))
+ (when (re-search-forward "^\\.$" nil t)
+ (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"
+ (concat "\"" pgg-pgp-user-id "\""))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-pgp)
+ start end)
+ (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"
+ key-file)))
+ (write-region-as-raw-text-CRLF start end key-file)
+ (pgg-pgp-process-region start end nil pgg-pgp-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp)
+
+;;; pgg-pgp.el ends here
--- /dev/null
+;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp5 ()
+ "PGP 5.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp5-pgpe-program "pgpe"
+ "PGP 5.* 'pgpe' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgps-program "pgps"
+ "PGP 5.* 'pgps' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpk-program "pgpk"
+ "PGP 5.* 'pgpk' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(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>\"."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-extra-args nil
+ "Extra arguments for every PGP 5.* invocation."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(eval-and-compile
+ (luna-define-class pgg-scheme-pgp5 (pgg-scheme)))
+
+(defvar pgg-pgp5-user-id nil
+ "PGP 5.* ID of your default identity.")
+
+(defvar pgg-scheme-pgp5-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-pgp5 ()
+ (or pgg-scheme-pgp5-instance
+ (setq pgg-scheme-pgp5-instance
+ (luna-make-entity 'pgg-scheme-pgp5))))
+
+(defun pgg-pgp5-process-region (start end passphrase program args)
+ (let* ((errors-file-name
+ (concat temporary-file-directory
+ (make-temp-name "pgg-errors")))
+ (args
+ (append args
+ pgg-pgp5-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp5-shell-file-name)
+ (shell-command-switch pgg-pgp5-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (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))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(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)
+ (buffer-disable-undo)
+ (erase-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
+ (buffer-substring (match-end 0)(progn (end-of-line)(point)))))
+ 2)))))
+
+(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
+ `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
+ ,@(if recipients
+ (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)
+ start end)
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'encrypt)))
+ (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)
+ start end &optional clearsign)
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'sign)))
+ (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
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(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))
+ (args '("+verbose=1" "+batchmode=1" "+language=us"))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (write-region-as-binary start end orig-file))
+ (set-default-file-modes orig-mode))
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpv-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (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"
+ (concat "\"" pgg-pgp5-user-id "\""))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-pgp5)
+ start end)
+ (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"
+ key-file)))
+ (write-region-as-raw-text-CRLF start end key-file)
+ (pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp5)
+
+;;; pgg-pgp5.el ends here
--- /dev/null
+;;; pgg.el --- glue for the various PGP implementations.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'calist)
+
+(eval-and-compile (require 'luna))
+
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(eval-when-compile
+ (ignore-errors
+ (require 'w3)
+ (require 'url)))
+
+(in-calist-package 'pgg)
+
+(defun pgg-field-match-method-with-containment
+ (calist field-type field-value)
+ (let ((s-field (assq field-type calist)))
+ (cond ((null s-field)
+ (cons (cons field-type field-value) calist))
+ ((memq (cdr s-field) field-value)
+ calist))))
+
+(define-calist-field-match-method 'signature-version
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'symmetric-key-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'public-key-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'hash-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(defvar pgg-verify-condition nil
+ "Condition-tree about which PGP implementation is used for verifying.")
+
+(defvar pgg-decrypt-condition nil
+ "Condition-tree about which PGP implementation is used for decrypting.")
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3)(public-key-algorithm RSA)(hash-algorithm MD5)
+ (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm RSA)(symmetric-key-algorithm IDEA)
+ (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3 4)
+ (public-key-algorithm RSA ELG DSA)
+ (hash-algorithm MD5 SHA1 RIPEMD160)
+ (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm RSA ELG DSA)
+ (symmetric-key-algorithm 3DES CAST5 IDEA)
+ (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3 4)
+ (public-key-algorithm ELG-E DSA ELG)
+ (hash-algorithm MD5 SHA1 RIPEMD160)
+ (scheme . gpg)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm ELG-E DSA ELG)
+ (symmetric-key-algorithm 3DES CAST5 BLOWFISH TWOFISH)
+ (scheme . gpg)))
+
+;;; @ definition of the implementation scheme
+;;;
+
+(eval-and-compile
+ (luna-define-class pgg-scheme ())
+
+ (luna-define-internal-accessors 'pgg-scheme))
+
+(luna-define-generic pgg-scheme-lookup-key (scheme string &optional type)
+ "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-decrypt-region (scheme start end)
+ "Decrypt the current region between START and END.")
+
+(luna-define-generic pgg-scheme-sign-region
+ (scheme start end &optional cleartext)
+ "Make detached signature from text 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.")
+
+(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.")
+
+;;; @ utility functions
+;;;
+
+(defvar pgg-fetch-key-function (function pgg-fetch-key-with-w3))
+
+(defmacro pgg-make-scheme (scheme)
+ `(progn
+ (require (intern (format "pgg-%s" ,scheme)))
+ (funcall (intern (format "pgg-make-scheme-%s"
+ ,scheme)))))
+
+(put 'pgg-save-coding-system 'lisp-indent-function 2)
+
+(defmacro pgg-save-coding-system (start end &rest body)
+ `(if (interactive-p)
+ (let ((buffer (current-buffer)))
+ (with-temp-buffer
+ (let (buffer-undo-list)
+ (insert-buffer-substring buffer ,start ,end)
+ (encode-coding-region (point-min)(point-max)
+ buffer-file-coding-system)
+ (prog1 (save-excursion ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))))
+ (save-restriction
+ (narrow-to-region ,start ,end)
+ ,@body)))
+
+(defun pgg-temp-buffer-show-function (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
+ (progn
+ (delete-region start end)
+ (insert-buffer-substring pgg-output-buffer)
+ (decode-coding-region start (point) buffer-file-coding-system))
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring pgg-errors-buffer)))))
+
+(defvar pgg-passphrase-cache-expiry 16)
+(defvar pgg-passphrase-cache (make-vector 7 0))
+
+(defvar pgg-read-passphrase nil)
+(defun pgg-read-passphrase (prompt &optional key)
+ (if (not pgg-read-passphrase)
+ (if (functionp 'read-passwd)
+ (setq pgg-read-passphrase 'read-passwd)
+ (if (load "passwd" t)
+ (setq pgg-read-passphrase 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq pgg-read-passphrase 'ange-ftp-read-passwd))))
+ (or (and pgg-cache-passphrase
+ key (setq key (pgg-truncate-key-identifier key))
+ (symbol-value (intern-soft key pgg-passphrase-cache)))
+ (funcall pgg-read-passphrase prompt)))
+
+(defun pgg-add-passphrase-cache (key passphrase)
+ (setq key (pgg-truncate-key-identifier key))
+ (set (intern key pgg-passphrase-cache)
+ passphrase)
+ (run-at-time pgg-passphrase-cache-expiry nil
+ #'pgg-remove-passphrase-cache
+ key))
+
+(defun pgg-remove-passphrase-cache (key)
+ (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache))))
+ (when passphrase
+ (fillarray passphrase ?_)
+ (unintern key pgg-passphrase-cache))))
+
+(defmacro pgg-convert-lbt-region (start end lbt)
+ `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
+ (goto-char ,start)
+ (case ,lbt
+ (CRLF
+ (while (progn
+ (end-of-line)
+ (> (marker-position pgg-conversion-end) (point)))
+ (insert "\r")
+ (forward-line 1)))
+ (LF
+ (while (re-search-forward "\r$" pgg-conversion-end t)
+ (replace-match ""))))))
+
+(put 'pgg-as-lbt 'lisp-indent-function 3)
+
+(defmacro pgg-as-lbt (start end lbt &rest body)
+ `(let ((inhibit-read-only t)
+ buffer-read-only
+ buffer-undo-list)
+ (pgg-convert-lbt-region ,start ,end ,lbt)
+ (let ((,end (point)))
+ ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))
+
+(put 'pgg-process-when-success 'lisp-indent-function 0)
+
+(defmacro pgg-process-when-success (&rest body)
+ `(with-current-buffer pgg-output-buffer
+ (if (zerop (buffer-size)) nil ,@body t)))
+
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun pgg-encrypt-region (start end rcpts)
+ "Encrypt the current region between START and END for RCPTS."
+ (interactive
+ (list (region-beginning)(region-end)
+ (split-string (read-string "Recipients: ") "[ \t,]+")))
+ (let* ((entity (pgg-make-scheme pgg-default-scheme))
+ (status
+ (pgg-save-coding-system start end
+ (pgg-scheme-encrypt-region entity (point-min)(point-max) rcpts))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (interactive "r")
+ (let* ((packet (cdr (assq 1 (pgg-parse-armor-region start end))))
+ (scheme
+ (or pgg-scheme
+ (cdr (assq 'scheme
+ (progn
+ (in-calist-package 'pgg)
+ (ctree-match-calist pgg-decrypt-condition
+ packet))))
+ pgg-default-scheme))
+ (entity (pgg-make-scheme scheme))
+ (status
+ (pgg-save-coding-system start end
+ (pgg-scheme-decrypt-region entity (point-min)(point-max)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-sign-region (start end &optional cleartext)
+ "Make the signature from text between START and END.
+If the optional 3rd argument CLEARTEXT is non-nil, it does not create
+a detached signature."
+ (interactive "r")
+ (let* ((entity (pgg-make-scheme pgg-default-scheme))
+ (status (pgg-save-coding-system start end
+ (pgg-scheme-sign-region entity (point-min)(point-max)
+ (or (interactive-p) cleartext)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-verify-region (start end &optional signature fetch)
+ "Verify the current region between START and END.
+If the optional 3rd argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region.
+
+If the optional 4th argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'."
+ (interactive "r")
+ (let* ((packet
+ (if (null signature) nil
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (set-buffer-multibyte nil)
+ (insert-file-contents signature)
+ (cdr (assq 2 (pgg-decode-armor-region
+ (point-min)(point-max)))))))
+ (scheme
+ (or pgg-scheme
+ (cdr (assq 'scheme
+ (progn
+ (in-calist-package 'pgg)
+ (ctree-match-calist pgg-verify-condition
+ packet))))
+ pgg-default-scheme))
+ (entity (pgg-make-scheme scheme))
+ (key (cdr (assq 'key-identifier packet)))
+ status keyserver)
+ (and (stringp key)
+ (setq key (concat "0x" (pgg-truncate-key-identifier key)))
+ (null (let ((pgg-scheme scheme))
+ (pgg-lookup-key key)))
+ (or fetch (interactive-p))
+ (y-or-n-p (format "Key %s not found; attempt to fetch? " key))
+ (setq keyserver
+ (or (cdr (assq 'preferred-key-server packet))
+ pgg-default-keyserver-address))
+ (pgg-fetch-key keyserver key))
+ (setq status (pgg-save-coding-system start end
+ (pgg-scheme-verify-region entity (point-min)(point-max)
+ signature)))
+ (when (interactive-p)
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer)))))
+ status))
+
+;;;###autoload
+(defun pgg-insert-key ()
+ "Insert the ASCII armored public key."
+ (interactive)
+ (let ((entity (pgg-make-scheme (or pgg-scheme pgg-default-scheme))))
+ (pgg-scheme-insert-key entity)))
+
+;;;###autoload
+(defun pgg-snarf-keys-region (start end)
+ "Import public keys in the current region between START and END."
+ (interactive "r")
+ (let ((entity (pgg-make-scheme (or pgg-scheme pgg-default-scheme))))
+ (pgg-save-coding-system start end
+ (pgg-scheme-snarf-keys-region entity start end))))
+
+(defun pgg-lookup-key (string &optional type)
+ (let ((entity (pgg-make-scheme (or pgg-scheme pgg-default-scheme))))
+ (pgg-scheme-lookup-key entity string type)))
+
+(defvar pgg-insert-url-function (function pgg-insert-url-with-w3))
+
+(defun pgg-insert-url-with-w3 (url)
+ (require 'w3)
+ (require 'url)
+ (let (buffer-file-name)
+ (url-insert-file-contents url)))
+
+(defvar pgg-insert-url-extra-arguments nil)
+(defvar pgg-insert-url-program nil)
+
+(defun pgg-insert-url-with-program (url)
+ (let ((args (copy-sequence pgg-insert-url-extra-arguments))
+ process)
+ (insert
+ (with-temp-buffer
+ (setq process
+ (apply #'start-process " *PGG url*" (current-buffer)
+ pgg-insert-url-program (nconc args (list url))))
+ (set-process-sentinel process #'ignore)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (delete-process process)
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (buffer-string)))))
+
+(defun pgg-fetch-key (keyserver key)
+ "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring."
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver)
+ (substring keyserver 0 (1- (match-end 0))))))
+ (save-excursion
+ (funcall pgg-insert-url-function
+ (if proto keyserver
+ (format "http://%s:11371/pks/lookup?op=get&search=%s"
+ keyserver key))))
+ (when (re-search-forward "^-+BEGIN" nil 'last)
+ (delete-region (point-min) (match-beginning 0))
+ (when (re-search-forward "^-+END" nil t)
+ (delete-region (progn (end-of-line) (point))
+ (point-max)))
+ (insert "\n")
+ (with-temp-buffer
+ (insert-buffer-substring pgg-output-buffer)
+ (pgg-snarf-keys-region (point-min)(point-max)))))))
+
+
+(provide 'pgg)
+
+;;; pgg.el ends here
--- /dev/null
+;;; postpet.el --- Postpet support for GNU Emacs
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Keywords: Postpet, MIME, multimedia, mail, news
+
+;; This file is part of SEMI (Sample of Elastic MIME Interfaces).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'alist)
+
+(put 'unpack 'lisp-indent-function 1)
+(defmacro unpack (string &rest body)
+ `(let* ((*unpack*string* (string-as-unibyte ,string))
+ (*unpack*index* 0))
+ ,@body))
+
+(defun unpack-skip (len)
+ (setq *unpack*index* (+ len *unpack*index*)))
+
+(defun unpack-fixed (len)
+ (prog1
+ (substring *unpack*string* *unpack*index* (+ *unpack*index* len))
+ (unpack-skip len)))
+
+(defun unpack-byte ()
+ (char-int (aref (unpack-fixed 1) 0)))
+
+(defun unpack-short ()
+ (let* ((b0 (unpack-byte))
+ (b1 (unpack-byte)))
+ (+ (* 256 b0) b1)))
+
+(defun unpack-long ()
+ (let* ((s0 (unpack-short))
+ (s1 (unpack-short)))
+ (+ (* 65536 s0) s1)))
+
+(defun unpack-string ()
+ (let ((len (unpack-byte)))
+ (unpack-fixed len)))
+
+(defun unpack-string-sjis ()
+ (decode-mime-charset-string (unpack-string) 'shift_jis))
+
+;;;###autoload
+(defun postpet-decode (string)
+ (condition-case nil
+ (unpack string
+ (let (res)
+ (unpack-skip 4)
+ (set-alist 'res 'carryingcount (unpack-long))
+ (unpack-skip 8)
+ (set-alist 'res 'sentyear (unpack-short))
+ (set-alist 'res 'sentmonth (unpack-short))
+ (set-alist 'res 'sentday (unpack-short))
+ (unpack-skip 8)
+ (set-alist 'res 'petname (unpack-string-sjis))
+ (set-alist 'res 'owner (unpack-string-sjis))
+ (set-alist 'res 'pettype (unpack-fixed 4))
+ (set-alist 'res 'health (unpack-short))
+ (unpack-skip 2)
+ (set-alist 'res 'sex (unpack-long))
+ (unpack-skip 1)
+ (set-alist 'res 'brain (unpack-byte))
+ (unpack-skip 39)
+ (set-alist 'res 'happiness (unpack-byte))
+ (unpack-skip 14)
+ (set-alist 'res 'petbirthyear (unpack-short))
+ (set-alist 'res 'petbirthmonth (unpack-short))
+ (set-alist 'res 'petbirthday (unpack-short))
+ (unpack-skip 8)
+ (set-alist 'res 'from (unpack-string))
+ (unpack-skip 5)
+ (unpack-skip 160)
+ (unpack-skip 4)
+ (unpack-skip 8)
+ (unpack-skip 8)
+ (unpack-skip 26)
+ (set-alist 'res 'treasure (unpack-short))
+ (set-alist 'res 'money (unpack-long))
+ res))
+ (error nil)))
+
+;;;###autoload
+(defun mime-display-application/x-postpet (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max)(point-max))
+ (let ((pet (postpet-decode (mime-entity-content entity))))
+ (if pet
+ (insert
+ "Petname: " (cdr (assq 'petname pet))
+ "\n"
+ "Owner: " (cdr (assq 'owner pet))
+ "\n"
+ "Pettype: " (cdr (assq 'pettype pet))
+ "\n"
+ "From: " (cdr (assq 'from pet))
+ "\n"
+ "CarryingCount: " (int-to-string (cdr (assq 'carryingcount pet)))
+ "\n"
+ "SentYear: " (int-to-string (cdr (assq 'sentyear pet)))
+ "\n"
+ "SentMonth: " (int-to-string (cdr (assq 'sentmonth pet)))
+ "\n"
+ "SentDay: " (int-to-string (cdr (assq 'sentday pet)))
+ "\n"
+ "PetbirthYear: " (int-to-string (cdr (assq 'petbirthyear pet)))
+ "\n"
+ "PetbirthMonth: " (int-to-string (cdr (assq 'petbirthmonth pet)))
+ "\n"
+ "PetbirthDay: " (int-to-string (cdr (assq 'petbirthday pet)))
+ "\n"
+ "Health: " (int-to-string (cdr (assq 'health pet)))
+ "\n"
+ "Sex: " (int-to-string (cdr (assq 'sex pet)))
+ "\n"
+ "Brain: " (int-to-string (cdr (assq 'brain pet)))
+ "\n"
+ "Happiness: " (int-to-string (cdr (assq 'happiness pet)))
+ "\n"
+ "Treasure: " (int-to-string (cdr (assq 'treasure pet)))
+ "\n"
+ "Money: " (int-to-string (cdr (assq 'money pet)))
+ "\n")
+ (insert "Invalid format\n"))
+ (run-hooks 'mime-display-application/x-postpet-hook))))
+
+
+;;; @ end
+;;;
+
+(provide 'postpet)
+
+;;; postpet.el ends here
;;; semi-def.el --- definition module for SEMI -*- coding: iso-8859-4; -*-
-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: definition, MIME, multimedia, mail, news
(require 'custom)
-(defconst mime-user-interface-product ["SEMI" (1 13 7) "Awazu"]
+(defconst mime-user-interface-product ["REMI" (1 14 3) "Matsudai"]
"Product name, version number and code name of MIME-kernel package.")
(autoload 'mule-caesar-region "mule-caesar"
(defsubst mime-add-button (from to function &optional data)
"Create a button between FROM and TO with callback FUNCTION and DATA."
- (let ((overlay (make-overlay from to)))
- (and mime-button-face
- (overlay-put overlay 'face mime-button-face))
- (and mime-button-mouse-face
- (overlay-put overlay 'mouse-face mime-button-mouse-face))
- (add-text-properties from to (list 'mime-button-callback function))
- (and data
- (add-text-properties from to (list 'mime-button-data data)))
- ))
+ (and mime-button-face
+ (put-text-property from to 'face mime-button-face))
+ (and mime-button-mouse-face
+ (put-text-property from to 'mouse-face mime-button-mouse-face))
+ (put-text-property from to 'mime-button-callback function)
+ (and data
+ (put-text-property from to 'mime-button-data data))
+ )
(defsubst mime-insert-button (string function &optional data)
"Insert STRING as button with callback FUNCTION and DATA."
)
-;;; @ PGP
-;;;
-
-(defvar pgp-function-alist
- '(
- ;; for mime-pgp
- (verify mc-verify "mc-toplev")
- (decrypt mc-decrypt "mc-toplev")
- (fetch-key mc-pgp-fetch-key "mc-pgp")
- (snarf-keys mc-snarf-keys "mc-toplev")
- ;; for mime-edit
- (mime-sign mime-mc-pgp-sign-region "mime-mc")
- (traditional-sign mc-pgp-sign-region "mc-pgp")
- (encrypt mime-mc-pgp-encrypt-region "mime-mc")
- (insert-key mc-insert-public-key "mc-toplev")
- )
- "Alist of service names vs. corresponding functions and its filenames.
-Each element looks like (SERVICE FUNCTION FILE).
-
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt'
-or `insert-key'.
-
-Function is a symbol of function to do specified SERVICE.
-
-FILE is string of filename which has definition of corresponding
-FUNCTION.")
-
-(defmacro pgp-function (method)
- "Return function to do service METHOD."
- `(cadr (assq ,method (symbol-value 'pgp-function-alist))))
-
-(mapcar (function
- (lambda (method)
- (autoload (cadr method)(nth 2 method))
- ))
- pgp-function-alist)
-
-
;;; @ Other Utility
;;;
;;; semi-setup.el --- setup file for MIME-View.
-;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word
;; This file is part of SEMI (Setting for Emacs MIME Interfaces).
))
-;; for image/* and X-Face
+;; for image/*
(defvar mime-setup-enable-inline-image
(and window-system
- (or (featurep 'xemacs)
- (and (featurep 'mule)(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
- (call-after-loaded 'mime-view
- (function
- (lambda ()
- (require 'mime-image)
- )))
- )
-
+ (eval-after-load "mime-view"
+ '(require 'mime-image)))
;; for text/html
(defvar mime-setup-enable-inline-html
"*If it is non-nil, semi-setup sets up to use mime-w3.")
(if mime-setup-enable-inline-html
- (call-after-loaded
- 'mime-view
- (function
- (lambda ()
- (autoload 'mime-preview-text/html "mime-w3")
-
- (ctree-set-calist-strictly
- 'mime-preview-condition
- '((type . text)(subtype . html)
- (body . visible)
- (body-presentation-method . mime-preview-text/html)))
-
- (set-alist 'mime-view-type-subtype-score-alist
- '(text . html) 3)
- )))
- )
+ (eval-after-load "mime-view"
+ '(progn
+ (autoload 'mime-preview-text/html "mime-w3")
+
+ (ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . text)(subtype . html)
+ (body . visible)
+ (body-presentation-method . mime-preview-text/html)))
+
+ (set-alist 'mime-view-type-subtype-score-alist
+ '(text . html) 3)
+ )))
;; for PGP
-(defvar mime-setup-enable-pgp
- (module-installed-p 'mailcrypt)
+(defvar mime-setup-enable-pgp t
"*If it is non-nil, semi-setup sets uf to use mime-pgp.")
(if mime-setup-enable-pgp
'((type . application)(subtype . pgp-keys)
(method . mime-add-application/pgp-keys))
'strict "mime-pgp")
+
+ (mime-add-condition
+ 'action
+ '((type . application)(subtype . pkcs7-signature)
+ (method . mime-verify-application/pkcs7-signature))
+ 'strict "mime-pgp")
+
+ (mime-add-condition
+ 'action
+ '((type . application)(subtype . x-pkcs7-signature)
+ (method . mime-verify-application/pkcs7-signature))
+ 'strict "mime-pgp")
+
+ (mime-add-condition
+ 'action
+ '((type . application)(subtype . pkcs7-mime)
+ (method . mime-view-application/pkcs7-mime))
+ 'strict "mime-pgp")
+
+ (mime-add-condition
+ 'action
+ '((type . application)(subtype . x-pkcs7-mime)
+ (method . mime-view-application/pkcs7-mime))
+ 'strict "mime-pgp")
))
)
;;; @ for mime-edit
;;;
-(defun mime-setup-decode-message-header ()
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region
- (point-min)
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (match-beginning 0)
- (point-max)
- ))
- (mime-decode-header-in-buffer)
- (set-buffer-modified-p nil)
- )))
-
-(add-hook 'mime-edit-mode-hook 'mime-setup-decode-message-header)
+;; (defun mime-setup-decode-message-header ()
+;; (save-excursion
+;; (save-restriction
+;; (goto-char (point-min))
+;; (narrow-to-region
+;; (point-min)
+;; (if (re-search-forward
+;; (concat "^" (regexp-quote mail-header-separator) "$")
+;; nil t)
+;; (match-beginning 0)
+;; (point-max)
+;; ))
+;; (mime-decode-header-in-buffer)
+;; (set-buffer-modified-p nil)
+;; )))
+
+;; (add-hook 'mime-edit-mode-hook 'mime-setup-decode-message-header)
;;; @@ variables
;;; @ for mu-cite
;;;
-(add-hook 'mu-cite/pre-cite-hook 'eword-decode-header)
+;; (add-hook 'mu-cite/pre-cite-hook 'eword-decode-header)
;;; @ end
;;; signature.el --- a signature utility for GNU Emacs
-;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1994,1995,1996,1997,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
-;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
-;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Maintainer: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Created: 1994/7/11
-;; Version: $Id: signature.el,v 7.16 1997/09/24 23:17:38 shuhei-k Exp $
;; Keywords: mail, news, signature
;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
--- /dev/null
+;;; smime.el --- S/MIME interface.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/12/08
+;; Keywords: S/MIME, OpenSSL
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;; This module is based on
+
+;; [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"
+;; by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,
+;; Pawling, J. and Schaad, J. (1999/06)
+
+;; [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"
+;; by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.
+;; and L. Repka. (1998/03)
+
+;;; Code:
+
+(require 'path-util)
+(eval-when-compile (require 'static))
+
+(defgroup smime ()
+ "S/MIME interface"
+ :group 'mime)
+
+(defcustom smime-program "smime"
+ "The S/MIME executable."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-shell-file-name "/bin/sh"
+ "File name to load inferior shells from. Bourne shell or its equivalent
+\(not tcsh) is needed for \"2>\"."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-x509-program
+ (let ((file (exec-installed-p "openssl")))
+ (and file (list file "x509" "-noout")))
+ "External program for x509 parser."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-cache-passphrase t
+ "Cache passphrase."
+ :group 'smime
+ :type 'boolean)
+
+(defcustom smime-certificate-directory "~/.w3/certs"
+ "Certificate directory."
+ :group 'smime
+ :type 'directory)
+
+(defcustom smime-public-key-file nil
+ "Public key file."
+ :group 'smime
+ :type 'boolean)
+
+(defcustom smime-private-key-file nil
+ "Private key file."
+ :group 'smime
+ :type 'boolean)
+
+(defvar smime-errors-buffer " *S/MIME errors*")
+(defvar smime-output-buffer " *S/MIME output*")
+
+;;; @ utility functions
+;;;
+(put 'smime-process-when-success 'lisp-indent-function 0)
+
+(defmacro smime-process-when-success (&rest body)
+ `(with-current-buffer smime-output-buffer
+ (if (zerop (buffer-size)) nil ,@body t)))
+
+(defvar smime-passphrase-cache-expiry 16)
+(defvar smime-passphrase-cache (make-vector 7 0))
+
+(defvar smime-read-passphrase nil)
+(defun smime-read-passphrase (prompt &optional key)
+ (if (not smime-read-passphrase)
+ (if (functionp 'read-passwd)
+ (setq smime-read-passphrase 'read-passwd)
+ (if (load "passwd" t)
+ (setq smime-read-passphrase 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq smime-read-passphrase 'ange-ftp-read-passwd))))
+ (or (and smime-cache-passphrase
+ (symbol-value (intern-soft key smime-passphrase-cache)))
+ (funcall smime-read-passphrase prompt)))
+
+(defun smime-add-passphrase-cache (key passphrase)
+ (set (intern key smime-passphrase-cache)
+ passphrase)
+ (run-at-time smime-passphrase-cache-expiry nil
+ #'smime-remove-passphrase-cache
+ key))
+
+(defun smime-remove-passphrase-cache (key)
+ (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
+ (when passphrase
+ (fillarray passphrase ?_)
+ (unintern key smime-passphrase-cache))))
+
+(defsubst smime-parse-attribute (string)
+ (delq nil (mapcar
+ (lambda (attr)
+ (if (string-match "=" attr)
+ (cons (intern (substring attr 0 (match-beginning 0)))
+ (substring attr (match-end 0)))
+ nil))
+ (split-string string "/"))))
+
+(defsubst smime-query-signer (start end)
+ (smime-process-region start end smime-program (list "-qs"))
+ (with-current-buffer smime-output-buffer
+ (if (zerop (buffer-size)) nil
+ (goto-char (point-min))
+ (when (re-search-forward "^/" nil t)
+ (smime-parse-attribute
+ (buffer-substring (point) (progn (end-of-line)(point)))))
+ )))
+
+(defsubst smime-x509-hash (cert-file)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process (car smime-x509-program) nil t nil
+ (append (cdr smime-x509-program)
+ (list "-hash" "-in" cert-file)))
+ (if (zerop (buffer-size)) nil
+ (buffer-substring (point-min) (1- (point-max))))))
+
+(defsubst smime-x509-subject (cert-file)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process (car smime-x509-program) nil t nil
+ (append (cdr smime-x509-program)
+ (list "-subject" "-in" cert-file)))
+ (if (zerop (buffer-size)) nil
+ (goto-char (point-min))
+ (when (re-search-forward "^subject=" nil t)
+ (smime-parse-attribute
+ (buffer-substring (point)(progn (end-of-line)(point))))))))
+
+(defsubst smime-find-certificate (attr)
+ (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
+ (cdr (assq 'CN (smime-x509-subject (car files))))
+ (cdr (assq 'CN attr)))
+ (string-equal
+ (cdr (assq 'Email (smime-x509-subject (car files))))
+ (cdr (assq 'Email attr))))
+ (throw 'found (car files)))
+ (pop files)))))
+
+(defun smime-process-region (start end program args)
+ (let* ((errors-file-name
+ (concat temporary-file-directory
+ (make-temp-name "smime-errors")))
+ (args (append args (list (concat "2>" errors-file-name))))
+ (shell-file-name smime-shell-file-name)
+ (shell-command-switch smime-shell-command-switch)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (as-binary-process
+ (setq process
+ (apply #'start-process-shell-command "*S/MIME*"
+ smime-output-buffer program args)))
+ (set-process-sentinel process 'ignore)
+ (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 smime-output-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" (point-max) t)
+ (replace-match ""))
+
+ (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 smime-errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)
+ (delete-file errors-file-name)
+
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ )
+ ))
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun smime-encrypt-region (start end)
+ "Encrypt the current region between START and END."
+ (let* ((key-file
+ (or smime-private-key-file
+ (expand-file-name (read-file-name "Public key file: "))))
+ (args (list "-e" key-file)))
+ (smime-process-region start end smime-program args)
+ (smime-process-when-success
+ (goto-char (point-min))
+ (delete-region (point-min) (progn
+ (re-search-forward "^$" nil t)
+ (1+ (point)))))))
+
+;;;###autoload
+(defun smime-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((key-file
+ (or smime-private-key-file
+ (expand-file-name (read-file-name "Private key file: "))))
+ (hash (smime-x509-hash key-file))
+ (passphrase (smime-read-passphrase
+ (format "S/MIME passphrase for %s: " hash)
+ hash))
+ (args (list "-d" key-file passphrase)))
+ (smime-process-region start end smime-program args)
+ (smime-process-when-success
+ (when smime-cache-passphrase
+ (smime-add-passphrase-cache hash passphrase)))))
+
+;;;###autoload
+(defun smime-sign-region (start end &optional cleartext)
+ "Make the signature from text between START and END.
+If the optional 3rd argument CLEARTEXT is non-nil, it does not create
+a detached signature."
+ (let* ((key-file
+ (or smime-private-key-file
+ (expand-file-name (read-file-name "Private key file: "))))
+ (hash (smime-x509-hash key-file))
+ (passphrase (smime-read-passphrase
+ (format "S/MIME passphrase for %s: " hash)
+ hash))
+ (args (list "-ds" key-file passphrase)))
+ (smime-process-region start end smime-program args)
+ (smime-process-when-success
+ (goto-char (point-min))
+ (delete-region (point-min) (progn
+ (re-search-forward "^$" nil t)
+ (1+ (point))))
+ (when smime-cache-passphrase
+ (smime-add-passphrase-cache hash passphrase)))))
+
+;;;###autoload
+(defun smime-verify-region (start end signature)
+ "Verify the current region between START and END.
+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))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (write-region-as-binary start end orig-file))
+ (set-default-file-modes orig-mode))
+ (with-temp-buffer
+ (insert-file-contents-as-binary signature)
+ (goto-char (point-max))
+ (insert-file-contents-as-binary
+ (or (smime-find-certificate
+ (smime-query-signer (point-min)(point-max)))
+ (expand-file-name
+ (read-file-name "Certificate file: "))))
+ (smime-process-region (point-min)(point-max) smime-program
+ (list "-dv" orig-file)))
+ (smime-process-when-success nil)))
+
+(provide 'smime)
+
+;;; smime.el ends here
projects / elisp / semi.git / commitdiff