From f88c828889eba80c7ca4aaa6f34dba277668d5f0 Mon Sep 17 00:00:00 2001 From: morioka Date: Thu, 16 Dec 1999 09:42:29 +0000 Subject: [PATCH] Merge emiko-1_13_8-tomo-1. --- ChangeLog | 590 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ EMIKO-VERSION | 21 ++ NEWS | 11 ++ README.en | 24 +-- SEMI-ELS | 5 +- SEMI-MK | 2 + mime-edit.el | 358 ++++++++++++++++++++++++++------- mime-image.el | 298 ++++++++++++++++------------ mime-pgp.el | 240 ++++++++++++---------- mime-play.el | 40 ++-- mime-ui-en.sgml | 30 ++- mime-ui-en.texi | 27 +-- mime-ui-ja.sgml | 28 +-- mime-ui-ja.texi | 27 +-- mime-view.el | 140 ++++++++++++- pgg-def.el | 73 +++++++ pgg-gpg.el | 281 ++++++++++++++++++++++++++ pgg-parse.el | 503 +++++++++++++++++++++++++++++++++++++++++++++++ pgg-pgp.el | 263 +++++++++++++++++++++++++ pgg-pgp5.el | 265 +++++++++++++++++++++++++ pgg.el | 434 ++++++++++++++++++++++++++++++++++++++++ semi-def.el | 41 +--- semi-setup.el | 27 ++- smime.el | 338 +++++++++++++++++++++++++++++++ 24 files changed, 3623 insertions(+), 443 deletions(-) create mode 100644 EMIKO-VERSION 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 smime.el diff --git a/ChangeLog b/ChangeLog index 7591d3e..f7c7a91 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,593 @@ +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 fot 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/EMIKO-VERSION b/EMIKO-VERSION new file mode 100644 index 0000000..dca6ef6 --- /dev/null +++ b/EMIKO-VERSION @@ -0,0 +1,21 @@ +Euglena gracilis EMIKO 1.13.6 +Euglena caudata EMIKO 1.13.7 +Euglena oxyuris EMIKO 1.13.8 +Euglena tripteris EMIKO 1.13.9 +Euglena proxima +Euglena viridis +Euglena sociabilis +Euglena ehrenbergii +Euglena deses +Euglena pisciformis +Strombomonas acuminata +Lepocinclis salina +Lepocinclis wangi +Phacus longicauda +Phacus pleuronectes +Notosolenus +Anisonema +Petalomonas +Peranema +Urceolus +Entosiphon \ No newline at end of file diff --git a/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..dc73eef 100644 --- a/README.en +++ b/README.en @@ -44,11 +44,11 @@ Required environment 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/ + ftp://ftp.m17n.org/pub/mule/flim/flim-1.13/ PGP/MIME and application/pgp require mailcrypt or tiny-pgp package. @@ -179,24 +179,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 diff --git a/SEMI-ELS b/SEMI-ELS index 6ffa7fc..9e19169 100644 --- a/SEMI-ELS +++ b/SEMI-ELS @@ -6,6 +6,8 @@ (setq semi-modules-to-compile '(signature + pgg-def pgg pgg-parse pgg-gpg pgg-pgp5 pgg-pgp mime-pgp + smime semi-def mime-view mime-play mime-partial mime-edit semi-setup mail-mime-setup)) @@ -23,8 +25,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/mime-edit.el b/mime-edit.el index 81b7613..c49d605 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1993,94,95,96,97,98,99 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,19 @@ (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.") ;;; @ version @@ -632,6 +646,11 @@ If it is not specified for a major-mode, " (" (mime-product-code-name mime-library-product) ") " + (condition-case nil + (progn + (require 'apel-ver) + (concat (apel-version) " ")) + (file-error nil)) (if (featurep 'xemacs) (concat (cond ((featurep 'utf-2000) (concat "UTF-2000-MULE/" utf-2000-version)) @@ -1633,6 +1652,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 +1723,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 @@ -1739,23 +1765,52 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (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 +1851,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 +1898,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 +1917,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 +1946,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 +1955,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) @@ -2308,12 +2444,22 @@ 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) ) @@ -2366,6 +2512,8 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (defvar mime-edit-pgp-processing nil) (make-variable-buffer-local 'mime-edit-pgp-processing) +(defvar mime-edit-pgp-user-id nil) + (defun mime-edit-set-sign (arg) (interactive (list @@ -2373,12 +2521,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 +2539,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 +2556,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 +2712,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 +2728,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) @@ -2616,7 +2773,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 +2806,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 +2847,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 +2875,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 +2981,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..bdfe1d8 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,139 +36,193 @@ ;;; Code: +(eval-when-compile (require 'static)) + (require 'mime-view) (require 'alist) +(require 'path-util) + +(cond + ((featurep 'xemacs) + + (require 'images) + + (defun-maybe image-inline-p (format) + (or (memq format image-native-formats) + (find-if (function + (lambda (native) + (image-converter-chain format native) + )) + image-native-formats) + )) + + (image-register-netpbm-utilities) + (image-register-converter 'pic 'ppm "pictoppm") + (image-register-converter 'mag 'ppm "magtoppm") + + (defun image-insert-at-point (image) + (let ((e (make-extent (point) (point)))) + (set-extent-end-glyph e (make-glyph image)))) + + (defsubst-maybe image-invalid-glyph-p (glyph) + (or (null (aref glyph 0)) + (null (aref glyph 2)) + (equal (aref glyph 2) "") + )) + ) + ((featurep 'mule) -(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) "") - )) + (eval-and-compile + (autoload 'bitmap-insert-xbm-buffer "bitmap") ) -(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) - )) + (static-if (fboundp 'image-type-available-p) + (defalias-maybe 'image-inline-p 'image-type-available-p) + (defvar image-native-formats '(xbm)) + (defun-maybe image-inline-p (format) + (memq format image-native-formats))) + + (defun-maybe image-normalize (format data) + (if (memq format '(xbm xpm)) + (list 'image ':type format ':data data) + (let ((image-file + (make-temp-name + (expand-file-name "tm" temporary-file-directory)))) + (with-temp-buffer + (insert data) + (write-region-as-binary (point-min)(point-max) image-file)) + (list 'image ':type format ':file image-file) + ))) + + (defun image-insert-at-point (image) + (static-if (fboundp 'insert-image) + (unwind-protect + (save-excursion + (static-if (condition-case nil + (progn (insert-image '(image)) nil) + (wrong-number-of-arguments t)) + (insert-image image "x") + (insert-image image)) + (insert "\n") + (save-window-excursion + (set-window-buffer (selected-window)(current-buffer)) + (sit-for 0))) + (let ((file (plist-get (cdr image) ':file))) + (and file (file-exists-p file) + (delete-file file) + ))) + (when (eq (plist-get (cdr image) ':type) 'xbm) + (save-restriction + (narrow-to-region (point)(point)) + (insert (plist-get (cdr image) ':data)) + (let ((mark (set-marker (make-marker) (point)))) + (bitmap-insert-xbm-buffer (current-buffer)) + (delete-region (point-min) mark)) + )))) + + (defsubst-maybe image-invalid-glyph-p (glyph) + (not (eq 'image (nth 0 glyph)))) + )) + +;; +;; X-Face +;; + +(cond + ((module-installed-p 'highlight-headers) + (eval-and-compile + (autoload 'highlight-headers "highlight-headers")) + + (defun mime-preview-x-face-function-use-highlight-headers () + (highlight-headers (point-min) (re-search-forward "^$" nil t) t) + ) + (add-hook 'mime-display-header-hook + 'mime-preview-x-face-function-use-highlight-headers) + ) + ((featurep 'mule) + (require 'x-face-mule) + (when (exec-installed-p uncompface-program exec-path) + (add-hook 'mime-display-header-hook + 'x-face-decode-message-header)) + )) + +(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 x-pic pic) + (image x-mag mag) + (image png png))) + +(dolist (rule mime-image-format-alist) + (let ((type (car rule)) + (subtype (nth 1 rule)) + (format (nth 2 rule))) + (when (image-inline-p format) + (ctree-set-calist-strictly + 'mime-preview-condition + (list (cons 'type type)(cons 'subtype subtype) + '(body . visible) + (cons 'body-presentation-method #'mime-display-image) + (cons 'image-format format)) + )))) ;;; @ content filter for images ;;; ;; (for XEmacs 19.12 or later) +(eval-when-compile + (defmacro mime-image-normalize-xbm (entity) + (` (with-temp-buffer + (mime-insert-entity-content (, entity)) + (let ((cur (current-buffer)) + width height) + (goto-char (point-min)) + (search-forward "width ") + (setq width (read cur)) + (goto-char (point-min)) + (search-forward "height ") + (setq height (read cur)) + (goto-char (point-min)) + (search-forward "{") + (delete-region (point-min) (point)) + (insert "\"") + (search-forward "}") + (delete-region (1- (point)) (point-max)) + (insert "\"") + (goto-char (point-min)) + (while (re-search-forward "[^\"0-9A-FXa-fx]+" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (search-forward "0x" nil t) + (replace-match "\\\\x")) + (goto-char (point-min)) + (, (if (featurep 'xemacs) + (` (vector 'xbm :data + (list width height (read cur)))) + '(` (image :type xbm :width (, width) :height (, height) + :data (, (read cur)))))))))) + ) + (defun mime-display-image (entity situation) (message "Decoding image...") - (let ((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 (if (or (featurep 'xemacs) (boundp 'image-types)) + (if (eq 'xbm format) + (mime-image-normalize-xbm entity) + (image-normalize format (mime-entity-content entity))) + (image-normalize format (mime-entity-content entity))))) + (if (image-invalid-glyph-p image) + (message "Invalid glyph!") + (image-insert-at-point image) + (message "Decoding image... done"))) + (static-when (featurep 'xemacs) + (insert "\n"))) ;;; @ end diff --git a/mime-pgp.el b/mime-pgp.el index fb76f45..6ddaec9 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -1,8 +1,9 @@ -;;; mime-pgp.el --- mime-view internal methods for PGP. +;;; mime-pgp.el --- mime-view internal methods foro PGP. ;; Copyright (C) 1995,1996,1997,1998,1999 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,25 @@ ;; 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.") ;;; @ Internal method for multipart/signed @@ -68,6 +85,7 @@ (new-name (format "%s-%s" (buffer-name) (mime-entity-number entity))) (mother (current-buffer)) + (preview-buffer (concat "*Preview-" (buffer-name) "*")) representation-type) (set-buffer (get-buffer-create new-name)) (erase-buffer) @@ -75,7 +93,7 @@ (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) @@ -96,61 +114,22 @@ ((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))) + (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 + (save-window-excursion (mime-view-buffer nil preview-buffer mother nil representation-type)) - (set-window-buffer p-win mime-preview-buffer) + (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 +141,37 @@ 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)) @@ -220,30 +187,97 @@ It should be ISO 639 2 letter language code such as en, ja, ...") ;;; @ 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)) + (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-decode-region (point-min)(point-max) encoding) - (funcall (pgp-function 'snarf-keys)) - (kill-buffer (current-buffer)) + (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-decrypt-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) "*")) + representation-type) + (set-buffer (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)) + (set-window-buffer p-win preview-buffer) + )) + + ;;; @ end ;;; diff --git a/mime-play.el b/mime-play.el index b4a03a2..b98ccea 100644 --- a/mime-play.el +++ b/mime-play.el @@ -36,6 +36,13 @@ (error (defvar bbdb-buffer-name nil))) ) +(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-acting-situation-example-list nil) (defvar mime-acting-situation-example-list-max-size 16) @@ -459,26 +466,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)) )) 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= emacs-major-version 19) window-system) "\ @@ -853,6 +958,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]) )) @@ -922,6 +1045,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))) @@ -1244,13 +1369,14 @@ It calls following-method selected from variable (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)))) + (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")) ))) diff --git a/pgg-def.el b/pgg-def.el new file mode 100644 index 0000000..c8fef62 --- /dev/null +++ b/pgg-def.el @@ -0,0 +1,73 @@ +;;; 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 'symbol + :type 'string) + +(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 + "Encrypt all outgoing messages with user's public key." + :group 'pgg + :type 'boolean) + +(defcustom pgg-cache-passphrase 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..e6528b6 --- /dev/null +++ b/pgg-gpg.el @@ -0,0 +1,281 @@ +;;; pgg-gpg.el --- GnuPG support for PGG. + +;; 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. + +;;; 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-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-gpg + :type 'string) + +(defcustom pgg-gpg-shell-command-switch "-c" + "Switch used to have the shell execute its command line argument." + :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* ((errors-file-name + (concat temporary-file-directory + (make-temp-name "pgg-errors"))) + (status-file-name + (concat temporary-file-directory + (make-temp-name "pgg-status"))) + (args + (append + `("--status-fd" "3" + ,@(if passphrase '("--passphrase-fd" "0")) + ,@pgg-gpg-extra-args) + args + (list (concat "2>" errors-file-name) + (concat "3>" status-file-name)))) + (shell-file-name pgg-gpg-shell-file-name) + (shell-command-switch pgg-gpg-shell-command-switch) + (output-buffer pgg-output-buffer) + (errors-buffer pgg-errors-buffer) + (status-buffer pgg-status-buffer) + (process-connection-type nil) + process status exit-status) + (with-current-buffer (get-buffer-create output-buffer) + (buffer-disable-undo) + (erase-buffer)) + (as-binary-process + (setq process + (apply #'start-process-shell-command "*GnuPG*" output-buffer + program args))) + (set-process-sentinel process 'ignore) + (when passphrase + (process-send-string process (concat passphrase "\n"))) + (process-send-region process start end) + (process-send-eof process) + (while (eq 'run (process-status process)) + (accept-process-output process 5)) + (setq status (process-status process) + exit-status (process-exit-status process)) + (delete-process process) + (with-current-buffer output-buffer + (pgg-convert-lbt-region (point-min)(point-max) 'LF) + + (if (memq status '(stop signal)) + (error "%s exited abnormally: '%s'" program exit-status)) + (if (= 127 exit-status) + (error "%s could not be found" program)) + + (set-buffer (get-buffer-create errors-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents errors-file-name) + (delete-file errors-file-name) + + (set-buffer (get-buffer-create status-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents status-file-name) + (delete-file status-file-name) + + (if (and process (eq 'run (process-status process))) + (interrupt-process process)) + ) + )) + +(luna-define-method lookup-key-string ((scheme pgg-scheme-gpg) + string &optional type) + (let ((args (list "--with-colons" "--no-greeting" "--batch" + (if type "--list-secret-keys" "--list-keys") + string))) + (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args) + (with-current-buffer pgg-output-buffer + (goto-char (point-min)) + (when (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 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 #'append + (mapcar (lambda (rcpt) + (list "--remote-user" + (concat "\"" 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 + (pgg-convert-lbt-region (point-min)(point-max) 'LF)) + )) + +(luna-define-method 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) + (luna-send scheme 'lookup-key-string + scheme pgg-gpg-user-id 'encrypt))) + (args '("--batch" "--decrypt"))) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) + (pgg-process-when-success nil) + )) + +(luna-define-method 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) + (luna-send scheme 'lookup-key-string + 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) + ) + (pgg-process-when-success + (pgg-convert-lbt-region (point-min)(point-max) 'LF) + (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX + (let ((packet + (cdr (assq 2 (pgg-parse-armor-region + (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 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) + (save-excursion + (set-buffer pgg-errors-buffer) + (goto-char (point-min)) + (while (re-search-forward "^gpg: " nil t) + (replace-match "")) + (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))))) + (set-buffer pgg-status-buffer) + (goto-char (point-min)) + (if (re-search-forward "^\\[GNUPG:] +GOODSIG +" nil t) + (progn + (set-buffer pgg-output-buffer) + (insert-buffer-substring pgg-errors-buffer) + t) + nil)) + )) + +(luna-define-method 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" + (concat "\"" pgg-gpg-user-id "\"")))) + (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args) + (insert-buffer-substring pgg-output-buffer) + )) + +(luna-define-method 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-status-buffer) + (goto-char (point-min)) + (when (re-search-forward "^\\[GNUPG:] +IMPORT_RES +" nil t) + (setq status (buffer-substring (match-end 0) + (progn (end-of-line) + (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 nil) + )) + +(provide 'pgg-gpg) + +;;; pgg-gpg.el ends here diff --git a/pgg-parse.el b/pgg-parse.el new file mode 100644 index 0000000..040ae1a --- /dev/null +++ b/pgg-parse.el @@ -0,0 +1,503 @@ +;;; 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..9193660 --- /dev/null +++ b/pgg-pgp.el @@ -0,0 +1,263 @@ +;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. + +;; Copyright (C) 1999 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 + "GnuPG 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) + (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")) + (as-binary-process + (setq process + (apply #'start-process-shell-command "*PGP*" output-buffer + program args))) + (set-process-sentinel process 'ignore) + (when passphrase + (process-send-string process (concat passphrase "\n"))) + (process-send-region process start end) + (process-send-eof process) + (while (eq 'run (process-status process)) + (accept-process-output process 5)) + (setq status (process-status process) + exit-status (process-exit-status process)) + (delete-process process) + (with-current-buffer output-buffer + (pgg-convert-lbt-region (point-min)(point-max) 'LF) + + (if (memq status '(stop signal)) + (error "%s exited abnormally: '%s'" program exit-status)) + (if (= 127 exit-status) + (error "%s could not be found" program)) + + (set-buffer (get-buffer-create errors-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents errors-file-name) + (delete-file errors-file-name) + + (if (and process (eq 'run (process-status process))) + (interrupt-process process)) + ) + )) + +(luna-define-method lookup-key-string ((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 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 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 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) + (luna-send scheme 'lookup-key-string + 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 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) + (luna-send scheme 'lookup-key-string + 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 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-min)(point-max) 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 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 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..e8066fb --- /dev/null +++ b/pgg-pgp5.el @@ -0,0 +1,265 @@ +;;; pgg-pgp5.el --- PGP 5.* support for PGG. + +;; Copyright (C) 1999 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 invocation." + :group 'pgg-pgp5 + :type 'string) + +(eval-and-compile + (luna-define-class pgg-scheme-pgp5 (pgg-scheme)) + ) + +(defvar pgg-pgp5-user-id nil + "GnuPG 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) + (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")) + (as-binary-process + (setq process + (apply #'start-process-shell-command "*PGP*" output-buffer + program args))) + (set-process-sentinel process 'ignore) + (when passphrase + (process-send-string process (concat passphrase "\n"))) + (process-send-region process start end) + (process-send-eof process) + (while (eq 'run (process-status process)) + (accept-process-output process 5)) + (setq status (process-status process) + exit-status (process-exit-status process)) + (delete-process process) + (with-current-buffer output-buffer + (pgg-convert-lbt-region (point-min)(point-max) 'LF) + + (if (memq status '(stop signal)) + (error "%s exited abnormally: '%s'" program exit-status)) + (if (= 127 exit-status) + (error "%s could not be found" program)) + + (set-buffer (get-buffer-create errors-buffer)) + (buffer-disable-undo) + (erase-buffer) + (insert-file-contents errors-file-name) + (delete-file errors-file-name) + + (if (and process (eq 'run (process-status process))) + (interrupt-process process)) + ) + )) + +(luna-define-method lookup-key-string ((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 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 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 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) + (luna-send scheme 'lookup-key-string + 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 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) + (luna-send scheme 'lookup-key-string + 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 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-min)(point-max) nil + pgg-pgp5-pgpv-program args) + (delete-file orig-file) + (if signature (delete-file signature)) + (pgg-process-when-success nil) + )) + +(luna-define-method 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 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..fd6eaea --- /dev/null +++ b/pgg.el @@ -0,0 +1,434 @@ +;;; pgg.el --- glue for the various PGP implementations. + +;; Copyright (C) 1999 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 lookup-key-string (scheme string &optional type) + "Search keys associated with STRING") + +(luna-define-generic encrypt-region (scheme start end recipients) + "Encrypt the current region between START and END.") + +(luna-define-generic decrypt-region (scheme start end) + "Decrypt the current region between START and END.") + +(luna-define-generic sign-region (scheme start end &optional cleartext) + "Make detached signature from text between START and END.") + +(luna-define-generic verify-region (scheme start end &optional signature) + "Verify region between START and END +as the detached signature SIGNATURE.") + +(luna-define-generic insert-key (scheme) + "Insert public key at point.") + +(luna-define-generic 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) + (if (one-window-p (selected-window)) + (let ((window (split-window-vertically + (- (window-height) + (/ (window-height) 5))))) + (set-window-buffer window buffer)) + (display-buffer buffer))) + +(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 + (luna-send entity '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 + (luna-send entity '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 + (luna-send entity '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-string 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 + (luna-send entity '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)))) + (luna-send entity '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 + (luna-send entity 'snarf-keys-region entity start end)))) + +(defun pgg-lookup-key-string (string &optional type) + (let ((entity (pgg-make-scheme (or pgg-scheme pgg-default-scheme)))) + (luna-send entity 'lookup-key-string 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/semi-def.el b/semi-def.el index 62baefd..27ed3e0 100644 --- a/semi-def.el +++ b/semi-def.el @@ -30,7 +30,7 @@ (require 'custom) -(defconst mime-user-interface-product ["SEMI" (1 13 7) "Awazu"] +(defconst mime-user-interface-product ["EMIKO" (1 13 9) "Euglena tripteris"] "Product name, version number and code name of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" @@ -165,45 +165,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..00d6500 100644 --- a/semi-setup.el +++ b/semi-setup.el @@ -83,8 +83,7 @@ it is used as hook to set." ;; 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 +122,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-decrypt-application/pkcs7-mime)) + 'strict "mime-pgp") + + (mime-add-condition + 'action + '((type . application)(subtype . x-pkcs7-mime) + (method . mime-decrypt-application/pkcs7-mime)) + 'strict "mime-pgp") )) ) diff --git a/smime.el b/smime.el new file mode 100644 index 0000000..8bd0ad8 --- /dev/null +++ b/smime.el @@ -0,0 +1,338 @@ +;;; 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)))))))) + +(static-condition-case nil + (directory-files nil nil nil nil nil) + (wrong-number-of-arguments + (defmacro smime-directory-files + (directory &optional full match nosort files-only) + (if files-only + `(delq nil (mapcar + (lambda (file) + ,(if (eq files-only t) + `(if (file-directory-p file) nil file) + `(if (file-directory-p file) file nil))) + (directory-files ,directory ,full ,match ,nosort))) + `(directory-files ,directory ,full ,match ,nosort)))) + (error + (defalias 'smime-directory-files 'directory-files))) + +(defsubst smime-find-certificate (attr) + (let ((files (if (file-directory-p smime-certificate-directory) + (delq nil (mapcar (lambda (file) + (if (file-directory-p file) nil + file)) + (directory-files + smime-certificate-directory + 'full))) + nil))) + (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)) + (args (list "-qs" signature)) + (orig-mode (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes 448) + (write-region-as-binary start end orig-file) + ) + (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