From 17cacd9ff91f19bac96c1b6f9db2c414a53d2b68 Mon Sep 17 00:00:00 2001 From: tomo Date: Fri, 24 Nov 2000 12:32:58 +0000 Subject: [PATCH] Merge remi-1_14_2-1. --- ChangeLog | 1114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ Makefile | 12 +- NEWS | 11 + README.en | 39 +- SEMI-ELS | 8 +- SEMI-MK | 2 + VERSION | 6 +- ftp.in | 18 +- mime-edit.el | 384 +++++++++++++++---- mime-image.el | 281 +++++++------- mime-pgp.el | 272 ++++++++------ mime-play.el | 338 +++-------------- mime-ui-en.sgml | 30 +- mime-ui-en.texi | 27 +- mime-ui-ja.sgml | 28 +- mime-ui-ja.texi | 27 +- mime-view.el | 935 ++++++++++++++++++++++++++++++++-------------- mime-w3.el | 8 +- pgg-def.el | 75 ++++ pgg-gpg.el | 234 ++++++++++++ pgg-parse.el | 494 ++++++++++++++++++++++++ pgg-pgp.el | 244 ++++++++++++ pgg-pgp5.el | 253 +++++++++++++ pgg.el | 421 +++++++++++++++++++++ postpet.el | 152 ++++++++ semi-def.el | 60 +-- semi-setup.el | 111 +++--- signature.el | 9 +- smime.el | 320 ++++++++++++++++ 29 files changed, 4798 insertions(+), 1115 deletions(-) create mode 100644 pgg-def.el create mode 100644 pgg-gpg.el create mode 100644 pgg-parse.el create mode 100644 pgg-pgp.el create mode 100644 pgg-pgp5.el create mode 100644 pgg.el create mode 100644 postpet.el create mode 100644 smime.el diff --git a/ChangeLog b/ChangeLog index 7591d3e..b677275 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,1117 @@ +2000-10-19 Takanori Saneto + + * 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 + + * mime-edit.el (mime-file-types): Fix to use application/msword + instead of application/winword. + +2000-08-11 MORIOKA Tomohiko + + * mime-view.el (mime-display-text/plain): Display warning message + when `mime-insert-text-content' fails. + +2000-08-04 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-process-region): Don't bind + coding-system-for-read. + +2000-07-04 Yuuichi Teranishi + + * mime-image.el (mime-image-insert) [XEmacs]: + Insert `string' only if it is non-nil. + +2000-06-27 Daiki Ueno + + * 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 + + * mime-edit.el (mime-edit-insert-key): Insert a text tag when + the buffer has any trailing text. + +2000-06-05 Shugo Maeda + + * pgg-gpg.el (pgg-scheme-insert-key): Don't quote user id. + +2000-05-21 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-process-region): Abolish redundant nconc. + +2000-05-16 Daiki Ueno + + * mime-image.el (mime-image-create) [XEmacs]: Don't call + `make-image-instance' directly. + +2000-05-02 Daiki Ueno + + * pgg-gpg.el (pgg-scheme-encrypt-region): Don't quote recipient; + concatenate all arguments destructively. + +2000-04-13 Daiki Ueno + + * 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 + + * mime-image.el (mime-display-image): Don't wait for redisplay. + + +2000-07-12 MORIOKA Tomohiko + + * REMI: Version 1.14.2 (Hokuhoku--DÒshima)-A released. + + * README.en (Required environment): Modify for FLIM-Chao 1.14.1. + +2000-07-11 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * README.en: Update for CVS via SSH. + +2000-04-28 MORIOKA Tomohiko + + * mime-edit.el (mime-charset-type-list): Add `iso-2022-jp-3'. + + +2000-03-01 MORIOKA Tomohiko + + * REMI: Version 1.14.1 (Mushigawa-Dòsugi)-A released. + +2000-03-01 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * mime-edit.el (mime-edit-normalize-body): Fix number of arguments + against enriched-encode. + +2000-02-23 Daiki Ueno + + * mime-image.el (mime-image-normalize-xbm-buffer): New inline + function. + (mime-image-create) [XEmacs || Emacs21]: Use it for XBM data. + (mime-display-image): Don't create temporary file. + +2000-02-22 MORIOKA Tomohiko + + * mime-view.el (mime-delq-null-situation): Accept multiple ignored + 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 + + * 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 + + * 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 + + * semi-def.el (mime-user-interface-product): Bump up to + EMIKO 1.13.12. + + * pgg.el (pgg-temp-buffer-show-function): Use + `shrink-window-if-larger-than-buffer'. + + * pgg-gpg.el (pgg-gpg-process-region): Fix cleanup form. + + * pgg-pgp.el (pgg-pgp-process-region): Ditto. + + * pgg-pgp5.el (pgg-pgp5-process-region): Ditto. + + * semi-setup.el (mime-setup-enable-inline-image): Remove checking + of bitmap-mule; use `eval-after-load' instead of + `call-after-loaded' to require `mime-image'. + + * mime-image.el (mime-display-image): Set default umask to 077. + (mime-image-create): Use `nothing-image-instance-p'. + + * mime-pgp.el: When it is compiled, define `smime-output-buffer' + and `smime-errors-buffer' to avoid compiler warning. + + * mime-edit.el: Ditto. + + * mime-pgp.el + (mime-view-application/pkcs7-mime): Regard smime-type as + "enveloped-data" unless it is specified. + + * smime.el (smime-directory-files): Abolish. + (smime-verify-region): Abolish local variable `args'. + +2000-02-20 Daiki Ueno + + * mime-image.el: Remove X-Face setting; require cl when compiling. + (mime-image-format-alist): Remove image/x-mag and image/x-pic. + (mime-image-type-available-p): New function. + (mime-image-create): New function. + (mime-image-insert): New function. + (mime-display-image): Rewrite. + + * mime-edit.el + (mime-edit-define-charset): Handle 'mime-charset-comment. + +2000-02-18 MORIOKA Tomohiko + + * mime-view.el (mime-view-define-keymap): Change binding of + `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'. + + +2000-02-17 MORIOKA Tomohiko + + * REMI: Version 1.14.0 (Uragawara) released. + +2000-02-17 MORIOKA Tomohiko + + * 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 + + * 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 + + * mime-view.el (mime-display-entity): Find + `header-presentation-method' only if `header-is-visible'. + +2000-02-10 MORIOKA Tomohiko + + * mime-view.el (mime-display-entity): Don't use + `mime-goto-header-start-point'. + +2000-02-10 MORIOKA Tomohiko + + * 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 + + * mime-view.el (mime-preview-follow-current-entity): Use + `mime-view-entity-body' to find body. + +2000-02-10 MORIOKA Tomohiko + + * 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 + + * mime-view.el (mime-preview-find-boundary-info): Use + - 1 instead of to get `mime-view-entity' property. + + * mime-view.el (mime-preview-follow-current-entity): Fix problem + in multipart entity. + +2000-02-07 Yoshiki Hayashi + + * mime-pgp.el: Fix doc string. + * pgg-def.el: Ditto. + * pgg-gpg.el: Ditto. + * pgg-parse.el: Ditto. + * pgg-pgp.el: Ditto. + * pgg-pgp5.el: Ditto. + * pgg.el: Ditto. + +2000-02-02 Nakagawa, Makoto + + * pgg-pgp5.el (pgg-scheme-verify-region): Copy the contents of + `pgg-errors-buffer' to `pgg-output-buffer'. + +2000-02-02 Daiki Ueno + + * pgg.el (pgg-temp-buffer-show-function): Don't check if the + selected window is the only window. + +2000-02-01 MORIOKA Tomohiko + + * semi-setup.el (mime-setup-enable-inline-image): Use "(fboundp + 'create-image)" to detect Emacs 21. + Use `eval-after-load' instead of `call-after-loaded' to require + `mime-image'. + +2000-02-01 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * mime-view.el (mime-reduce-situation-examples): New function; + delete `mime-reduce-acting-situation-examples'. + +2000-01-16 MORIOKA Tomohiko + + * 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 + + * 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 + + * mime-play.el (mime-play-entity): Use `mime-unify-situations'. + + * mime-view.el (mime-unify-situations): New function. + +2000-01-16 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * Makefile, README.en: Update for the new CVS server. + +1999-12-28 Daiki Ueno + + * mime-edit.el (mime-edit-user-agent-value): Don't require + `apel-ver' directly. + +1999-12-28 Katsumi Yamaoka + + * 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 + + * 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 + + * 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 + + * README.en: Update for the recent ML address and ftp site. + +1999-12-11 Daiki Ueno + + * 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 + + * 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 + + * 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 + + * smime.el (smime-x509-hash): Use `call-process' instead of + `call-process-region'. + (smime-x509-subject): Ditto. + +1999-12-08 Daiki Ueno + + * SEMI-ELS (semi-modules-to-compile): Add smime.el. + + * smime.el: New file. + +1999-11-30 Tsukamoto Tetsuo + + * mime-edit.el (mime-edit-decode-message-in-buffer): Don't decode + the message header twice. + +1999-11-30 Daiki Ueno + + * pgg.el (pgg-remove-passphrase-cache): Add checking whether + the passphrase has already been expired. + +1999-11-26 Daiki Ueno + + * 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--user-id' if specified. + (sign-region): Ditto. + (decrypt-region): Ditto. + (insert-key): Ditto. + +1999-11-26 Nakagawa, Makoto + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * mime-image.el (mime-image-normalize-xbm): New macro. + (mime-display-image): Use it. + +1999-11-13 Daiki Ueno + + * 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 + + * 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 + + * mime-image.el (image-normalize): Use `write-region-as-binary'. + +1999-11-11 Daiki Ueno + + * pgg-pgp.el, pgg-pgp5.el (verify-region): Set default umask to 077. + +1999-11-10 Daiki Ueno + + * 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 + + * mime-play.el: (mime-save-directory): New variable. + (mime-save-content): Don't force filename parameter to be used. + +1999-11-09 Daiki Ueno + + * pgg-pgp.el, pgg-pgp5.el + (sign-region): Don't convert line break code. + +1999-11-07 Daiki Ueno + + * 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 + + * 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 + + * 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 + + * pgg-parse.el (pgg-byte-after): Always pass the first argument + of `char-after'. + +1999-11-05 Daiki Ueno + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * pgg.el (pgg-verify-region): Ignore all errors encountered on + calling `pgg-fetch-key'. + +1999-11-04 Daiki Ueno + + * 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 + + * 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 + + * 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 + + * 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 + + * mime-edit.el (mime-edit-preview-message): Inherit the value of + `mime-edit-pgp-processing'. + +1999-11-04 Daiki Ueno + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * SEMI-MK (install-semi-package): Delte auto-autoloads.el + and custom-load.el + + 1999-10-16 MORIOKA Tomohiko * SEMI: Version 1.13.7 (Awazu) released. diff --git a/Makefile b/Makefile index 84d8c26..758331f 100644 --- a/Makefile +++ b/Makefile @@ -2,11 +2,11 @@ # 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 @@ -24,7 +24,7 @@ VERSION_SPECIFIC_LISPDIR = NONE 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: @@ -53,7 +53,7 @@ tar: 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' diff --git a/NEWS b/NEWS index 529574f..eaebaeb 100644 --- a/NEWS +++ b/NEWS @@ -3,6 +3,17 @@ Copyright (C) 1998,1999 Free Software Foundation, Inc. * 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 diff --git a/README.en b/README.en index 7f2d51b..56ffa9c 100644 --- a/README.en +++ b/README.en @@ -40,15 +40,16 @@ Required environment 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. @@ -179,24 +180,24 @@ Mailing lists ============= 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 @@ -204,10 +205,16 @@ 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:@cvs.m17n.org:/cvs/root. + + We hope you will join the open development. Authors diff --git a/SEMI-ELS b/SEMI-ELS index 6ffa7fc..448caf3 100644 --- a/SEMI-ELS +++ b/SEMI-ELS @@ -6,7 +6,10 @@ (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) @@ -23,8 +26,7 @@ (nconc semi-modules-not-to-compile i-modules)) ) ))) - '((mailcrypt mime-pgp mime-mc) - (bbdb mime-bbdb) + '((bbdb mime-bbdb) (w3 mime-w3) )) diff --git a/SEMI-MK b/SEMI-MK index bd5f525..2aed7f1 100644 --- a/SEMI-MK +++ b/SEMI-MK @@ -90,6 +90,8 @@ LISPDIR=%s\n" PREFIX LISPDIR)) (expand-file-name SEMI_PREFIX (expand-file-name "lisp" PACKAGEDIR))) + (delete-file "./auto-autoloads.el") + (delete-file "./custom-load.el") ) ;;; SEMI-MK ends here diff --git a/VERSION b/VERSION index 9c1fa27..7367163 100644 --- a/VERSION +++ b/VERSION @@ -91,7 +91,7 @@ ------- Kawake $(B2OLS(B ------- Torahime $(B8WI1(B ------- Nagahama $(BD9IM(B -------- Tamura $(BEDB<(B +------- Tamura $(BEDB<(B ------- Sakata $(B:dED(B (Maibara) ($(BJF86(B) ; = JR $(BEl3$F;K\@~(B @@ -214,6 +214,10 @@ 1.13.0 Saigata $(B:T3c(B ; = JR $(B?.1[K\@~(B 1.13.1 Kubiki $(B$/$S$-(B 1.13.2 -DÒike-Ikoinomori-A $(BBgCS$$$3$$$N?9(B +1.14.0 Uragawara $(B$&$i$,$o$i(B +1.14.1 Mushigawa-Dòsugi-A $(BCn@nBg?y(B +1.14.2 Hokuhoku--DÒshima-A $(B$[$/$[$/BgEg(B +1.14.3 Matsudai $(B$^$D$@$$(B [etc.] diff --git a/ftp.in b/ftp.in index 848fbe2..f15aa34 100644 --- a/ftp.in +++ b/ftp.in @@ -2,18 +2,14 @@ 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; diff --git a/mime-edit.el b/mime-edit.el index 81b7613..d6899a3 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -1,9 +1,10 @@ ;;; 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 -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko +;; Daiki Ueno ;; Created: 1994/08/21 renamed from mime.el ;; Renamed: 1997/2/21 from tm-edit.el ;; Keywords: MIME, multimedia, multilingual, mail, news @@ -114,6 +115,21 @@ (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 @@ -301,7 +317,7 @@ To insert a signature file automatically, call the function ;; Octect binary text ("\\.doc$" ;MS Word - "application" "winword" nil + "application" "msword" nil "base64" "attachment" (("filename" . file)) ) @@ -483,6 +499,7 @@ If encoding is nil, it is determined from its contents." (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") @@ -510,7 +527,6 @@ If encoding is nil, it is determined from its contents." "A string formatted version of mime-transfer-level") (make-variable-buffer-local 'mime-transfer-level-string) - ;;; @@ about content transfer encoding (defvar mime-content-transfer-encoding-priority-list @@ -632,6 +648,8 @@ If it is not specified for a major-mode, " (" (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)) @@ -1384,7 +1402,11 @@ Optional argument ENCODING specifies an encoding method such as base64." (mime-create-tag (mime-edit-set-parameter (mime-edit-get-contype tag) - "charset" (upcase (symbol-name charset))) + "charset" + (let ((comment (get charset 'mime-charset-comment))) + (if comment + (concat (upcase (symbol-name charset)) " (" comment ")") + (upcase (symbol-name charset))))) (mime-edit-get-encoding tag))) )))) @@ -1633,6 +1655,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (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) @@ -1703,6 +1726,12 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." ((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 @@ -1736,26 +1765,57 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (replace-match (concat "-" (substring tag 2))) ))))) +(defvar mime-edit-pgp-user-id nil) + (defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction - (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")) @@ -1796,28 +1856,41 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (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\"; @@ -1830,6 +1903,7 @@ Content-Type: application/octet-stream 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)) ))))) @@ -1848,9 +1922,7 @@ Content-Transfer-Encoding: 7bit (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) @@ -1879,10 +1951,7 @@ Content-Transfer-Encoding: 7bit (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) @@ -1891,6 +1960,78 @@ Content-Transfer-Encoding: 7bit )) ))) +(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) @@ -2104,7 +2245,7 @@ Content-Transfer-Encoding: 7bit ;; (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)) @@ -2308,13 +2449,25 @@ and insert data encoded as ENCODING." (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 @@ -2373,12 +2526,14 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." )) (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.") )) @@ -2389,12 +2544,14 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." )) (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.") )) @@ -2404,15 +2561,18 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (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)) + ))) ))) @@ -2557,6 +2717,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (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 @@ -2572,6 +2733,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (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) @@ -2581,19 +2743,18 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (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 @@ -2616,7 +2777,12 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" 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) @@ -2644,13 +2810,36 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ) (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)) @@ -2662,7 +2851,8 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ))) )) -(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)) @@ -2689,7 +2879,38 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" 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) @@ -2764,19 +2985,24 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (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 diff --git a/mime-image.el b/mime-image.el index d5e4aa0..76c2335 100644 --- a/mime-image.el +++ b/mime-image.el @@ -4,7 +4,9 @@ ;; Copyright (C) 1996 Dan Rich ;; Author: MORIOKA Tomohiko -;; Dan Rich +;; Dan Rich +;; Daiki Ueno +;; Katsumi Yamaoka ;; Maintainer: MORIOKA Tomohiko ;; Created: 1995/12/15 ;; Renamed: 1997/2/21 from tm-image.el @@ -34,102 +36,151 @@ ;;; 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 ;;; @@ -137,37 +188,15 @@ (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 ;;; diff --git a/mime-pgp.el b/mime-pgp.el index fb76f45..718ad9e 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -1,8 +1,9 @@ ;;; 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 +;; Author: MORIOKA Tomohiko +;; Daiki Ueno ;; Created: 1995/12/7 ;; Renamed: 1997/2/27 from tm-pgp.el ;; Keywords: PGP, security, MIME, multimedia, mail, news @@ -41,9 +42,27 @@ ;; by Kazuhiko Yamamoto (1995/10; ;; expired) +;; [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME +;; Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO +;; (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 @@ -68,14 +87,15 @@ (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) @@ -88,69 +108,29 @@ (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." @@ -162,49 +142,35 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (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)) @@ -214,36 +180,102 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (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 ;;; diff --git a/mime-play.el b/mime-play.el index b4a03a2..e43b872 100644 --- a/mime-play.el +++ b/mime-play.el @@ -1,8 +1,8 @@ ;;; 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 +;; Author: MORIOKA Tomohiko ;; Created: 1995/9/26 (separated from tm-view.el) ;; Renamed: 1997/2/21 from tm-play.el ;; Keywords: MIME, multimedia, mail, news @@ -36,113 +36,15 @@ (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 @@ -175,136 +77,21 @@ If MODE is specified, play as it. Default MODE is \"play\"." (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" @@ -459,26 +246,25 @@ window.") ;;; (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)) )) @@ -529,15 +315,14 @@ SUBTYPE is symbol to indicate subtype of media-type.") (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 @@ -584,14 +369,14 @@ It is registered to variable `mime-preview-quitting-method-alist'." (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"))) @@ -639,9 +424,8 @@ It is registered to variable `mime-preview-quitting-method-alist'." (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))) @@ -654,11 +438,15 @@ It is registered to variable `mime-preview-quitting-method-alist'." (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) ))))) @@ -728,26 +516,4 @@ It is registered to variable `mime-preview-quitting-method-alist'." (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 diff --git a/mime-ui-en.sgml b/mime-ui-en.sgml index 6f1b876..7a02f72 100644 --- a/mime-ui-en.sgml +++ b/mime-ui-en.sgml @@ -370,7 +370,7 @@ Insert signature. C-c C-x C-k -Insert PGP public key. (It requires Mailcrypt package.) +Insert PGP public key. C-c C-x t @@ -609,29 +609,21 @@ mime-edit provides PGP encryption, signature and inserting public-key features based on PGP/MIME (RFC 2015) or PGP-kazu (draft-kazu-pgp-mime-00.txt).

-This feature requires pgp command and pgp interface package, such as -Mailcrypt package. +This feature requires your pgp command. - +

-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. +Version of PGP or GnuPG command to be used for encryption or sign. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. - - method +

-Return function to do service method. - +Version of PGP or GnuPG command to be used for decryption or verification. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. +

Mouse button diff --git a/mime-ui-en.texi b/mime-ui-en.texi index 9946c5f..2cde0f9 100644 --- a/mime-ui-en.texi +++ b/mime-ui-en.texi @@ -681,29 +681,22 @@ mime-edit provides PGP encryption, signature and inserting public-key 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 diff --git a/mime-ui-ja.sgml b/mime-ui-ja.sgml index 2e1094a..9bb5473 100644 --- a/mime-ui-ja.sgml +++ b/mime-ui-ja.sgml @@ -624,29 +624,21 @@ mime-edit $B$G$O(B PGP/MIME (RFC 2015) $B$*$h$S(B PGP-kazu (draft-kazu-pgp-mime-00.txt) $B$K$h$k0E9f2=!&(B $BEE;R=pL>!&8x3+80$NA^F~5!G=$rMxMQ$9$k$3$H$,$G$-$^$9!#(B

-$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O(B Mailcrypt package -$B$H(B pgp command $B$,I,MW$G$9!#(B +$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F +

-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. +Version of PGP or GnuPG command to be used for encryption or sign. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. - - method +

-Return function to do service method. - +Version of PGP or GnuPG command to be used for decryption or verification. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. +

$B2!KU(B diff --git a/mime-ui-ja.texi b/mime-ui-ja.texi index 24583c1..8293821 100644 --- a/mime-ui-ja.texi +++ b/mime-ui-ja.texi @@ -698,29 +698,22 @@ mime-edit $B$G$O(B @strong{PGP/MIME} (RFC 2015) $B$*$h$S(B@strong{PGP-kazu} (draft-kazu-pgp-mime-00.txt) $B$K$h$k0E9f2=!&EE;R=pL>!&8x3+80$NA^F~5!G=$r(B $BMxMQ$9$k$3$H$,$G$-$^$9!#(B@refill -$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O(B Mailcrypt package (@ref{(mailcrypt)}) $B$H(B -pgp command $B$,I,MW$G$9!#(B +$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F +;; Author: MORIOKA Tomohiko ;; Created: 1994/07/13 ;; Renamed: 1994/08/31 from tm-body.el ;; Renamed: 1997/02/19 from tm-view.el @@ -52,13 +52,8 @@ "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) @@ -72,6 +67,7 @@ buttom. Nil means don't scroll at all." (const :tag "On" t) (sexp :tag "Situation" 1))) + ;;; @ in raw-buffer (representation space) ;;; @@ -91,27 +87,6 @@ major-mode or t. t means default. REPRESENTATION-TYPE must be `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) ;;; @@ -224,41 +199,282 @@ mother-buffer." 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 @@ -270,21 +486,21 @@ mother-buffer." ;;; @@@ 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 ;;; @@ -451,6 +667,14 @@ Each elements are regexp of field-name.") (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) @@ -464,21 +688,32 @@ Each elements are regexp of field-name.") (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 @@ -487,7 +722,11 @@ Each elements are regexp of field-name.") (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)) @@ -517,6 +756,7 @@ Each elements are regexp of field-name.") (enriched-decode beg (point-max)) ))) + (defvar mime-view-announcement-for-message/partial (if (and (>= emacs-major-version 19) window-system) "\ @@ -586,11 +826,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (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 @@ -620,13 +857,11 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (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 @@ -752,71 +987,74 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (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)))) ))) @@ -853,6 +1091,24 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (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]) )) @@ -887,6 +1143,28 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." "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 @@ -922,6 +1200,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." 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))) @@ -976,9 +1256,7 @@ keymap of MIME-View mode." (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) @@ -1085,17 +1363,69 @@ button-2 Move to point under the mouse cursor ) (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 ;;; @@ -1129,144 +1459,79 @@ It decodes current entity to call internal or external method as 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 @@ -1436,6 +1701,65 @@ If LINES is negative, scroll up LINES lines." (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 ;;; @@ -1461,6 +1785,43 @@ It calls function registered in variable (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 diff --git a/mime-w3.el b/mime-w3.el index 6ce9927..ff2aecc 100644 --- a/mime-w3.el +++ b/mime-w3.el @@ -1,8 +1,8 @@ ;;; 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 +;; Author: MORIOKA Tomohiko ;; Keywords: HTML, MIME, multimedia, mail, news ;; This file is part of SEMI (Suite of Emacs MIME Interfaces). @@ -46,9 +46,7 @@ (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") diff --git a/pgg-def.el b/pgg-def.el new file mode 100644 index 0000000..1227996 --- /dev/null +++ b/pgg-def.el @@ -0,0 +1,75 @@ +;;; pgg-def.el --- functions/macros for defining PGG functions + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/pgg-gpg.el b/pgg-gpg.el new file mode 100644 index 0000000..5ac69f6 --- /dev/null +++ b/pgg-gpg.el @@ -0,0 +1,234 @@ +;;; pgg-gpg.el --- GnuPG support for PGG. + +;; Copyright (C) 1999,2000 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/pgg-parse.el b/pgg-parse.el new file mode 100644 index 0000000..910b0ff --- /dev/null +++ b/pgg-parse.el @@ -0,0 +1,494 @@ +;;; pgg-parse.el --- OpenPGP packet parsing + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 , +;; Jon Callas , Lutz Donnerhacke , +;; Hal Finney and Rodney Thayer +;; (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 diff --git a/pgg-pgp.el b/pgg-pgp.el new file mode 100644 index 0000000..4f3fbd7 --- /dev/null +++ b/pgg-pgp.el @@ -0,0 +1,244 @@ +;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. + +;; Copyright (C) 1999,2000 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/pgg-pgp5.el b/pgg-pgp5.el new file mode 100644 index 0000000..83e8187 --- /dev/null +++ b/pgg-pgp5.el @@ -0,0 +1,253 @@ +;;; pgg-pgp5.el --- PGP 5.* support for PGG. + +;; Copyright (C) 1999,2000 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/pgg.el b/pgg.el new file mode 100644 index 0000000..6975eef --- /dev/null +++ b/pgg.el @@ -0,0 +1,421 @@ +;;; pgg.el --- glue for the various PGP implementations. + +;; Copyright (C) 1999,2000 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/postpet.el b/postpet.el new file mode 100644 index 0000000..f8730bb --- /dev/null +++ b/postpet.el @@ -0,0 +1,152 @@ +;;; postpet.el --- Postpet support for GNU Emacs + +;; Copyright (C) 1999,2000 Free Software Foundation, Inc. + +;; Author: Tanaka Akira +;; 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 diff --git a/semi-def.el b/semi-def.el index 62baefd..483fd1b 100644 --- a/semi-def.el +++ b/semi-def.el @@ -1,6 +1,6 @@ ;;; 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 ;; Keywords: definition, MIME, multimedia, mail, news @@ -30,7 +30,7 @@ (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" @@ -61,15 +61,14 @@ (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." @@ -165,45 +164,6 @@ ) -;;; @ 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 ;;; diff --git a/semi-setup.el b/semi-setup.el index 9928d1e..ecdf2ae 100644 --- a/semi-setup.el +++ b/semi-setup.el @@ -1,8 +1,8 @@ ;;; 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 +;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word ;; This file is part of SEMI (Setting for Emacs MIME Interfaces). @@ -41,22 +41,15 @@ it is used as hook to set." )) -;; for image/* and X-Face +;; for image/* (defvar mime-setup-enable-inline-image (and window-system - (or (featurep 'xemacs) - (and (featurep 'mule)(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 @@ -64,27 +57,23 @@ it is used as hook to set." "*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 @@ -123,6 +112,30 @@ it is used as hook to set." '((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") )) ) @@ -130,23 +143,23 @@ it is used as hook to set." ;;; @ 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 @@ -184,7 +197,7 @@ it is used as hook to set." ;;; @ for mu-cite ;;; -(add-hook 'mu-cite/pre-cite-hook 'eword-decode-header) +;; (add-hook 'mu-cite/pre-cite-hook 'eword-decode-header) ;;; @ end diff --git a/signature.el b/signature.el index f06f53c..6bd81c3 100644 --- a/signature.el +++ b/signature.el @@ -1,13 +1,12 @@ ;;; 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 +;; Author: MORIOKA Tomohiko ;; OKABE Yasuo -;; Shuhei KOBAYASHI -;; Maintainer: Shuhei KOBAYASHI +;; Shuhei KOBAYASHI +;; Maintainer: Shuhei KOBAYASHI ;; 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). diff --git a/smime.el b/smime.el new file mode 100644 index 0000000..d01ee0d --- /dev/null +++ b/smime.el @@ -0,0 +1,320 @@ +;;; smime.el --- S/MIME interface. + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 -- 1.7.10.4