+1999-12-14 Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+
+ * mime-view.el (mime-preview-follow-current-entity): Fetch
+ field of `mime-view-following-required-fields-list' from parent entity
+ if it is not exist in current entity.
+
+1999-12-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * README.en: Update fot the recent ML address and ftp site.
+
+1999-12-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * smime.el (smime-encrypt-region): Delete entity header.
+ (smime-sign-region): Ditto.
+
+ * mime-edit.el: Fix autoload settings for `smime-sign-region' and
+ `smime-encrypt-region.
+ (mime-edit-sign-smime): Set Content-Type
+ `application/pkcs7-signature' instead of
+ `application/x-pkcs7-signature'; add Content-Description.
+ (mime-edit-encrypt-smime): Set content-type
+ `application/pkcs7-mime' instead of `x-application/pkcs7-mime'.
+
+ * mime-pgp.el: Fix autoload settings for `smime-verify-region' and
+ `smime-decrypt-region.
+ (mime-decrypt-application/pkcs7-mime):
+ Bind `inhibit-read-only' to t.
+
+1999-12-09 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * semi-def.el (mime-user-interface-product): Bump up to
+ EMIKO 1.13.9.
+
+ * smime.el: Require `static' when compiling.
+ (smime-directory-files): New macro.
+ (smime-find-certificate): Use it.
+
+1999-12-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * smime.el (smime-verify-region): Abolish local variable `cert-file'.
+ (smime-find-certificate): Rename from `smime-search-certificate'.
+
+ * mime-edit.el: Add autoload settings for `smime-encrypt-region' and
+ `smime-sign-region'.
+ (mime-edit-process-multipart-1): Handle type "smime-signed" and
+ "smime-encrypted".
+ (mime-edit-sign-smime): New function.
+ (mime-edit-encrypt-smime): New function.
+ (mime-edit-enclose-smime-signed-region): New function.
+ (mime-edit-enclose-smime-encrypted-region): New function.
+
+ * mime-pgp.el: Add autoload settings for `smime-decrypt-region' and
+ `smime-verify-region'.
+ (mime-verify-application/pkcs7-signature): New function.
+ (mime-decrypt-application/pkcs7-mime): New function.
+
+ * semi-setup.el: Set up for `mime-verify-application/pkcs7-signature'
+ and `mime-decrypt-application/pkcs7-mime'.
+
+1999-12-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * smime.el (smime-x509-hash): Use `call-process' instead of
+ `call-process-region'.
+ (smime-x509-subject): Ditto.
+
+1999-12-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * SEMI-ELS (semi-modules-to-compile): Add smime.el.
+
+ * smime.el: New file.
+
+1999-11-30 Tsukamoto Tetsuo <czkmt@remus.dti.ne.jp>
+
+ * mime-edit.el (mime-edit-decode-message-in-buffer): Don't decode
+ the message header twice.
+
+1999-11-30 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-remove-passphrase-cache): Add checking whether
+ the passphrase has already been expired.
+
+1999-11-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-pgp-user-id): New variable.
+ (mime-edit-sign-pgp-mime): Undo last change; refer
+ `mime-edit-pgp-user-id'.
+ (mime-edit-encrypt-pgp-mime): Ditto.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el
+ (encrypt-region): Refer `pgg-<impl>-user-id' if specified.
+ (sign-region): Ditto.
+ (decrypt-region): Ditto.
+ (insert-key): Ditto.
+
+1999-11-26 Nakagawa, Makoto <Makoto.Nakagawa@jp.compaq.com>
+
+ * mime-edit.el (mime-edit-sign-pgp-mime): Regard
+ `pgg-default-user-id' as more preferrable if it's specified.
+ (mime-edit-encrypt-pgp-mime): Ditto.
+
+1999-11-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * semi-def.el (mime-user-interface-product): Bump up to
+ EMIKO 1.13.8.
+
+ * pgg.el (pgg-remove-passphrase-cache): Don't unbind passphrase.
+
+1999-11-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-sign-pgp-mime): Bind
+ `pgg-default-user-id' to the canonical address of From field.
+
+ * pgg-def.el (pgg-cache-passphrase): New user option.
+
+ * pgg.el (pgg-read-passphrase): Refer `pgg-cache-passphrase'.
+ (pgg-remove-passphrase-cache): Fill cached passphrase with `_'.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (sign-region): Refer
+ `pgg-cache-passphrase'.
+
+1999-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-image.el (mime-display-image): Use
+ `mime-image-normalize-xbm' if the feature `xemacs' is provided or
+ the variable `image-types' is bound.
+
+1999-11-17 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-image.el (mime-image-normalize-xbm): Work for the future
+ FSF Emacsen as well.
+ (mime-display-image): Always use `mime-image-normalize-xbm'.
+
+1999-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-image.el (mime-image-normalize-xbm): New macro.
+ (mime-display-image): Use it.
+
+1999-11-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-temp-buffer-show-function): New function.
+ (pgg-display-output-buffer): Use it.
+ (pgg-save-coding-system): Use buffer narrowing.
+ (pgg-encrypt-region, pgg-decrypt-region, pgg-sign-region,
+ pgg-verify-region): Assume that the current region has already
+ been narrowed.
+
+1999-11-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-def.el (pgg-default-keyserver-address): Default to
+ `wwwkeys.pgp.net'.
+
+ * pgg.el (pgg-save-coding-system): New macro.
+ (pgg-display-output-buffer): New function.
+ (pgg-encrypt-region, pgg-decrypt-region, pgg-sign-region,
+ pgg-verify-region, pgg-insert-key, pgg-snarf-keys-region):
+ Add documentation string; use `pgg-save-coding-system'.
+ (pgg-fetch-key): Fix documentation.
+
+1999-11-11 Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+
+ * mime-image.el (image-normalize): Use `write-region-as-binary'.
+
+1999-11-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-pgp.el, pgg-pgp5.el (verify-region): Set default umask to 077.
+
+1999-11-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-gpg.el (pgg-gpg-process-region): Enclose `start-process'
+ with `as-binary-process'.
+
+ * pgg-pgp.el (pgg-pgp-process-region): Enclose `start-process'
+ with `as-binary-process'.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Enclose `start-process'
+ with `as-binary-process'.
+
+ * mime-edit.el (mime-edit-set-sign): Remove duplication.
+ (mime-edit-set-encrypt): Ditto.
+ (mime-edit-encrypt-pgp-mime): Encode header before encrypting.
+
+ * mime-image.el (image-insert-at-point): Check the number of the
+ arguments of `insert-image'.
+ (mime-display-image): Rewrite.
+
+1999-11-10 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+
+ * mime-play.el: (mime-save-directory): New variable.
+ (mime-save-content): Don't force filename parameter to be used.
+
+1999-11-09 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-pgp.el, pgg-pgp5.el
+ (sign-region): Don't convert line break code.
+
+1999-11-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-verify-application/pgp-signature): Don't
+ scroll MIME-echo buffer, just set window starting point.
+ (mime-add-application/pgp-keys): Ditto.
+
+1999-11-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-sign-region): Add optional argument `cleartext'.
+
+ * mime-ui-en.sgml, mime-ui-ja.sgml: Remove description about
+ `pgp-functions-alist' and `pgp-function'; add description about
+ `pgg-default-scheme' and `pgg-scheme'.
+
+ * NEWS (PGP 5.0i and GnuPG are now supported for PGP/MIME):
+ New section.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (encrypt-region): Add
+ sender's user id to the recipients list if `pgg-encrypt-for-me' is
+ specified.
+
+ * pgg-def.el (pgg-encrypt-for-me): New user option.
+
+ * mime-edit.el:
+ (mime-edit-decode-multipart-in-buffer): Sync up with semi-pgpgpg_20.
+ (mime-edit-decode-message-in-buffer): Ditto.
+ (mime-edit-decode-single-part-in-buffer): Ditto.
+
+1999-11-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-verify-region): Bind `pgg-scheme' in the predicate
+ of whether to fetch signer's public key.
+ (pgg-convert-lbt-region): New macro.
+ (pgg-as-lbt): New macro.
+
+ * mime-edit.el (mime-edit-encrypt-pgp-mime): Extract canonical
+ address of From field to use it as default user id; tokenize
+ bodies of the recipient fields.
+ (mime-edit-make-encrypt-recipient-header): Undo last change.
+ (mime-edit-translate-buffer): Do `undo-boundary'
+ before translating.
+
+ * pgg-gpg.el (sign-region): Use `pgg-as-lbt'.
+ (pgg-gpg-process-region): Use `pgg-convert-lbt-region'.
+ (encrypt-region): Don't ask passphrase.
+
+ * pgg-pgp5.el (sign-region): Use `pgg-as-lbt'.
+ (pgg-pgp5-process-region): Use `pgg-convert-lbt-region'.
+ (encrypt-region): Don't ask passphrase.
+
+ * pgg-pgp.el (verify-region): Fill errors buffer.
+ (pgg-pgp-process-region): Use `pgg-convert-lbt-region'.
+ (sign-region): Use `pgg-as-lbt'.
+ (encrypt-region): Don't ask passphrase.
+
+1999-11-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el (pgg-byte-after): Always pass the first argument
+ of `char-after'.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-pgp.el (sign-region): Fix regexp for the beginning of armor.
+
+ * pgg-gpg.el (encrypt-region): Don't use "--textmode" in GPG
+ arguments, replace line break code with CRLF while signing
+ instead.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-verify-application/pgp-signature): Copy the
+ messages in PGG buffers to MIME-echo buffer instead of binding
+ `pgg-output-buffer'.
+ (mime-add-application/pgp-keys): Likewise.
+
+ * pgg-gpg.el (verify-region): Fill errors buffer whether
+ verification has succeeded or not.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (snarf-keys-region):
+ Use `pgg-process-when-success'.
+
+ * pgg.el (pgg-encrypt-region): Add autoload cookie.
+ (pgg-decrypt-region): Ditto.
+ (pgg-sign-region): Ditto.
+ (pgg-verify-region): Don't modify the buffer; add autload cookie.
+ (pgg-snarf-keys-region): Add interactive spec; add autload cookie.
+ (pgg-insert-key): Add interactive spec; add autload cookie.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-gpg.el (pgg-gpg-shell-command-switch): New user option.
+ (pgg-gpg-process-region): Bind `shell-command-switch' to the value
+ of `pgg-gpg-shell-command-switch'.
+
+ * pgg-pgp.el (pgg-pgp-shell-command-switch): New user option.
+ (pgg-pgp-process-region): Bind `shell-command-switch' to the value
+ of `pgg-pgp-shell-command-switch'.
+
+ * pgg-pgp5.el (pgg-pgp5-shell-command-switch): New user option.
+ (pgg-pgp5-process-region): Bind `shell-command-switch' to the value
+ of `pgg-pgp5-shell-command-switch'.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (sign-region): Use fixed end
+ position of the signature.
+
+ * mime-pgp.el: Add autoload for `pgg-decrypt-region',
+ `pgg-verify-region', `pgg-snarf-keys-region'.
+ (mime-view-application/pgp): Don't use `pgp-function'.
+ (mime-verify-application/pgp-signature): Ditto.
+ (mime-add-application/pgp-keys): Ditto.
+ (mime-pgp-command): Abolish.
+ (mime-pgp-default-language): Abolish.
+ (mime-pgp-good-signature-regexp-alist): Abolish.
+ (mime-pgp-key-expected-regexp-alist): Abolish
+ (mime-pgp-check-signature): Abolish.
+
+ * semi-def.el (pgp-function-alist): Abolish.
+ (pgp-function): Abolish.
+
+ * mime-edit.el: Add autoload for `pgg-encrypt-region',
+ `pgg-sign-region', `pgg-insert-key'.
+ (mime-edit-sign-pgp-mime): Throw an error when
+ `pgg-sign-region' returns nil; don't use `pgp-function'.
+ (mime-edit-encrypt-pgp-mime): Throw an error when
+ `pgg-encrypt-region' returns nil; don't use `pgp-function'.
+ (mime-edit-sign-pgp-kazu): Don't use `pgp-function'.
+ (mime-edit-encrypt-pgp-mime): Ditto.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-add-application/pgp-keys): Don't display
+ public key block; snarf keys immediately.
+
+ * pgg.el (pgg-insert-url-with-program): Call program asynchronously.
+
+1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-def.el (pgg-echo-buffer): New variable.
+
+ * pgg.el (pgg-process-when-success): New macro.
+ (pgg-insert-url-with-w3): New function.
+ (pgg-insert-url-program): New variable.
+ (pgg-insert-url-extra-arguments): New variable.
+ (pgg-insert-url-function): New variable.
+ (pgg-fetch-key): Use it.
+ (pgg-encrypt-region): If called interactively, popup
+ `pgg-echo-buffer' to display encryption status.
+ (pgg-decrypt-region): Likewise.
+ (pgg-sign-region): Likewise.
+ (pgg-verify-region): Likewise.
+
+ * pgg-gpg.el (lookup-key-string): Use `call-process' instead of
+ `pgg-gpg-process-region'.
+ (encrypt-region): Use `pgg-process-when-success'; if the output
+ buffer is empty, don't copy errors, just return nil.
+ (decrypt-region): Likewise.
+ (verify-region): Check the contents of status buffer to looking
+ for `GOODSIG' response.
+ (sign-region): Accept optional argument `clearsign'.
+
+ * pgg-pgp.el (lookup-key-string): Use `call-process' instead of
+ `pgg-pgp-process-region'.
+ (encrypt-region): Use `pgg-process-when-success'; if the output
+ buffer is empty, don't copy errors, just return nil.
+ (decrypt-region): Likewise.
+ (verify-region): Likewise.
+ (sign-region): Accept optional argument `clearsign'.
+
+ * pgg-pgp5.el (lookup-key-string): Use `call-process' instead of
+ `pgg-pgp5-process-region'.
+ (encrypt-region): Use `pgg-process-when-success'; if the output
+ buffer is empty, don't copy errors, just return nil.
+ (decrypt-region): Likewise.
+ (verify-region): Likewise.
+ (sign-region): Accept optional argument `clearsign'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-verify-region): Ignore all errors encountered on
+ calling `pgg-fetch-key'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-pgp.el (mime-verify-application/pgp-signature): Enclose
+ with `unwind-protect' to be sure of deleting *.asc files.
+
+ * pgg-pgp.el (pgg-pgp-process-region): Set `PGPPASSFD' before
+ starting PGP process.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el (pgg-parse-crc24): Don't use any `write' ops.
+ (pgg-parse-crc24-string): Use `ccl-execute-on-string'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-set-sign): Preserve last status of
+ `mime-edit-pgp-processing'.
+ (mime-edit-set-encrypt): Ditto.
+ (mime-edit-pgp-enclose-buffer): Process
+ `mime-edit-pgp-enclose-buffer' consequently.
+
+ * pgg-parse.el (pgg-decode-packets): Don't use
+ `mime-encode-string'.
+ (pgg-ignore-packet-checksum): Default to t.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el: Rename the field name `cipher-algorithm' to
+ `symmetric-key-algorithm'.
+ (pgg-verify-condition): Fix documentation.
+ (pgg-decrypt-condition): Ditto.
+
+1999-11-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-edit.el (mime-edit-preview-message): Inherit the value of
+ `mime-edit-pgp-processing'.
+
+1999-11-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-encrypt-region): Add interactive spec.
+ (pgg-decrypt-region): Ditto.
+ (pgg-sign-region): Ditto.
+ (pgg-verify-region): Add optional argument `fetch' to fetch
+ signer's public key.
+
+ * pgg-def.el (pgg-default-keyserver-address): New variable.
+
+ * semi-def.el (pgp-function-alist): Remove `lookup-key'.
+
+ * mime-pgp.el (mime-display-application/pgp-signature): Abolish.
+ (mime-display-application/pgp-encrypted): Abolish.
+ (mime-display-application/pgp-keys): Abolish.
+ (mime-pgp-keyserver-url-template): Abolish.
+ (mime-pgp-keyserver-address): Abolish.
+ (mime-pgp-keyserver-port): Abolish.
+ (mime-pgp-keyserver-protocol): Abolish.
+ (mime-pgp-fetch-key): Abolish.
+
+ * semi-setup.el: Delete default setting of
+ `mime-display-application/pgp-signature',
+ `mime-display-application/pgp-encrypted',
+ `mime-display-application/pgp-keys'
+
+1999-11-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-fetch-key): Protect `buffer-file-name'.
+
+ * pgg-gpg.el (snarf-keys-region): Add `-' as extra argument of
+ gpg --import; convert status code into an integer.
+
+1999-11-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * semi-def.el (pgp-function-alist): Add `lookup-key'.
+
+ * pgg.el, pgg-gpg.el, pgg-pgp5.el, pgg-pgp.el:
+ Rename generic function `lookup-key' to `lookup-key-string';
+ add optional argument `type'.
+
+ * pgg-def.el (pgg-truncate-key-identifier): New macro.
+
+ * pgg.el: Rename generic function `lookup-key' to
+ `lookup-key-string'; add optional argument `type'.
+ (pgg-fetch-key): New function.
+ (pgg-snarf-keys-region): Fix typo.
+ (pgg-lookup-key-string): New function.
+ (pgg-read-passphrase): Use `pgg-truncate-key-identifier'.
+ (pgg-add-passphrase-cache): Ditto.
+
+ * mime-pgp.el (mime-pgp-keyserver-url-template): New variable
+ imported from semi-pgpgpg.
+ (mime-pgp-keyserver-address): Ditto.
+ (mime-pgp-keyserver-port): Ditto.
+ (mime-pgp-keyserver-protocol): New variable.
+ (mime-pgp-fetch-key): New function.
+ (mime-verify-application/pgp-signature): Prompt user to fetch
+ signer's public key.
+
+1999-11-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-fetch-public-key): New function.
+
+ * pgg-pgp.el (lookup-key): New generic function.
+ (encrypt-region): Use `lookup-key'; cache passphrase if the
+ encryption has done successfully.
+ (sign-region): Likewise.
+ (decrypt-region): Use `lookup-key'.
+
+ * pgg.el (pgg-scheme): Remove all slots.
+ (pgg-decrypt-codition): Rename tag `cipher-algorithm' to
+ `symmetric-key-algorithm'.
+ (lookup-key): Add documentation about the new generic function.
+
+ * pgg-parse.el (pgg-decode-armor-region): Remove autoload cookie.
+ (pgg-armor-header-lines): New variable.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg.el (pgg-add-passphrase-cache): Use only four octets of the key.
+ (pgg-read-passphrase): Ditto.
+
+ * pgg-pgp5.el (lookup-key): New generic function.
+ (encrypt-region): Use `lookup-key'; cache passphrase if the
+ encryption has done successfully.
+ (sign-region): Likewise.
+ (decrypt-region): Use `lookup-key'.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el
+ (pgg-parse-public-key-encrypted-session-key-packet):
+ Rename tag `public-key-identifier' to `key-identifier'.
+
+ * mime-pgp.el
+ (mime-display-application/pgp-encrypted): Refer it.
+
+ * pgg.el (pgg-passphrase-cache-expiry): New variable.
+ (pgg-passphrase-cache): New variable.
+ (pgg-read-passphrase): Add optional argument `key'.
+ (pgg-add-passphrase-cache): New function.
+ (pgg-remove-passphrase-cache): New function.
+
+ * pgg-gpg.el (lookup-key): New generic function.
+ (encrypt-region): Use `lookup-key'; cache passphrase if the
+ encryption has done successfully.
+ (sign-region): Likewise.
+ (decrypt-region): Use `lookup-key'.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * pgg-parse.el (pgg-parse-length-type): Fix typo.
+ (pgg-parse-public-key-encrypted-session-key-packet): Use
+ `pgg-read-bytes-string' instead of `pgg-read-bytes'.
+
+1999-11-02 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mime-edit.el (mime-edit-sign-pgp-mime): Rewrite with PGG functions.
+ (mime-edit-encrypt-pgp-mime): Likewise.
+ (mime-edit-encrypt-recipient-fields-list): Return recipients as list.
+
+ * mime-pgp.el: Add comment that this module is based on
+ draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) and RFC 2440
+ (OpenPGP Message Format) as well.
+ (mime-verify-application/pgp-signature): Use
+ `pgg-verify-region' instead of `mime-pgp-check-signature'.
+ (mime-display-application/pgp-signature): New function.
+ (mime-display-application/pgp-encrypted): New function.
+ (mime-display-application/pgp-keys): New function.
+
+ * semi-setup.el: Set up for
+ `mime-display-application/pgp-signature',
+ `mime-display-application/pgp-encrypted',
+ `mime-display-application/pgp-keys'.
+ (mime-setup-enable-pgp): Default to t.
+
+ * SEMI-ELS (semi-modules-to-compile): Add `pgg', `pgg-parse',
+ `pgg-gpg', `pgg-pgp' and `pgg-pgp5' instead of `mime-mc'.
+
+ * EMIKO-VERSION, pgg-def.el, pgg.el, pgg-gpg.el,
+ pgg-pgp5.el, pgg-pgp.el, pgg-parse.el: New file.
+
+ * mime-image.el (mime-display-image): Rewrite.
+
+ * semi-def.el (mime-user-interface-product): Modify for EMIKO.
+ (pgp-function-alist): Replace each method with PGG function.
+
+ * mime-view.el (mime-view-popup-menu): New variable.
+ (mime-view-popup-menu): New function.
+ (mime-view-define-keymap): Bind `mime-view-popup-menu' to
+ `mouse-button-3'.
+
+1999-11-01 Tanaka Akira <akr@jaist.ac.jp>
+ * mime-view.el (mime-display-application/x-postpet): New function.
+ (mime-preview-condition): Set up for
+ 'mime-preview-application/x-postpet.
+ (unpack): New macro.
+ (unpack-skip): New function.
+ (unpack-fixed): New function.
+ (unpack-byte): New function.
+ (unpack-short): New function.
+ (unpack-long): New function.
+ (unpack-string): New function.
+ (unpack-string-sjis): New function.
+ (postpet-decode): New function.
+
+1999-10-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+
+ * SEMI-MK (install-semi-package): Delte auto-autoloads.el
+ and custom-load.el
+
+\f
1999-10-16 MORIOKA Tomohiko <tomo@m17n.org>
* SEMI: Version 1.13.7 (Awazu) released.
--- /dev/null
+Euglena gracilis EMIKO 1.13.6
+Euglena caudata EMIKO 1.13.7
+Euglena oxyuris EMIKO 1.13.8
+Euglena tripteris EMIKO 1.13.9
+Euglena proxima
+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
* 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
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.
=============
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
(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))
(nconc semi-modules-not-to-compile i-modules))
)
)))
- '((mailcrypt mime-pgp mime-mc)
- (bbdb mime-bbdb)
+ '((bbdb mime-bbdb)
(w3 mime-w3)
))
(expand-file-name SEMI_PREFIX
(expand-file-name "lisp"
PACKAGEDIR)))
+ (delete-file "./auto-autoloads.el")
+ (delete-file "./custom-load.el")
)
;;; SEMI-MK ends here
;; Copyright (C) 1993,94,95,96,97,98,99 Free Software Foundation, Inc.
;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
;; Created: 1994/08/21 renamed from mime.el
;; Renamed: 1997/2/21 from tm-edit.el
;; Keywords: MIME, multimedia, multilingual, mail, news
(require 'signature)
(require 'alist)
(require 'invisible)
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(autoload 'pgg-encrypt-region "pgg"
+ "PGP encryption of current region." t)
+(autoload 'pgg-sign-region "pgg"
+ "PGP signature of current region." t)
+(autoload 'pgg-insert-key "pgg"
+ "Insert PGP public key at point." t)
+(autoload 'smime-encrypt-region "smime"
+ "S/MIME encryption of current region.")
+(autoload 'smime-sign-region "smime"
+ "S/MIME signature of current region.")
;;; @ version
" ("
(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))
(defun mime-edit-translate-buffer ()
"Encode the tagged MIME message in current buffer in MIME compliant message."
(interactive)
+ (undo-boundary)
(if (catch 'mime-edit-error
(save-excursion
(run-hooks 'mime-edit-translate-buffer-hook)
((string-equal type "kazu-encrypted")
(mime-edit-encrypt-pgp-kazu bb eb boundary)
)
+ ((string-equal type "smime-signed")
+ (mime-edit-sign-smime bb eb boundary)
+ )
+ ((string-equal type "smime-encrypted")
+ (mime-edit-encrypt-smime bb eb boundary)
+ )
(t
(setq boundary
(nth 2 (mime-edit-translate-region bb eb
(defun mime-edit-sign-pgp-mime (beg end boundary)
(save-excursion
(save-restriction
- (narrow-to-region beg end)
- (let* ((ret
- (mime-edit-translate-region beg end boundary))
+ (let* ((from (std11-field-body "From" mail-header-separator))
+ (ret (progn
+ (narrow-to-region beg end)
+ (mime-edit-translate-region beg end boundary)))
(ctype (car ret))
(encoding (nth 1 ret))
- (pgp-boundary (concat "pgp-sign-" boundary)))
+ (pgp-boundary (concat "pgp-sign-" boundary))
+ micalg)
(goto-char beg)
(insert (format "Content-Type: %s\n" ctype))
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding))
)
(insert "\n")
- (or (as-binary-process
- (funcall (pgp-function 'mime-sign)
- (point-min)(point-max) nil nil pgp-boundary))
+ (or (let ((pgg-default-user-id
+ (or mime-edit-pgp-user-id
+ (if from
+ (nth 1 (std11-extract-address-components from))
+ pgg-default-user-id))))
+ (pgg-sign-region (point-min)(point-max)))
(throw 'mime-edit-error 'pgp-error)
)
+ (setq micalg
+ (cdr (assq 'hash-algorithm
+ (cdar (with-current-buffer pgg-output-buffer
+ (pgg-parse-armor-region
+ (point-min)(point-max))))))
+ micalg
+ (if micalg
+ (concat "; micalg=pgp-" (downcase (symbol-name micalg)))
+ ""))
+ (goto-char beg)
+ (insert (format "--[[multipart/signed;
+ boundary=\"%s\"%s;
+ protocol=\"application/pgp-signature\"][7bit]]
+--%s
+" pgp-boundary micalg pgp-boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s
+Content-Type: application/pgp-signature
+Content-Transfer-Encoding: 7bit
+
+" pgp-boundary))
+ (insert-buffer-substring pgg-output-buffer)
+ (goto-char (point-max))
+ (insert (format "\n--%s--\n" pgp-boundary))
))))
(defvar mime-edit-encrypt-recipient-fields-list '("To" "cc"))
(save-excursion
(save-restriction
(let (from recipients header)
- (let ((ret (mime-edit-make-encrypt-recipient-header)))
- (setq from (aref ret 0)
- recipients (aref ret 1)
- header (aref ret 2))
+ (let ((ret (mime-edit-make-encrypt-recipient-header)))
+ (setq from (aref ret 0)
+ recipients (aref ret 1)
+ header (aref ret 2))
)
- (narrow-to-region beg end)
- (let* ((ret
- (mime-edit-translate-region beg end boundary))
- (ctype (car ret))
- (encoding (nth 1 ret))
- (pgp-boundary (concat "pgp-" boundary)))
- (goto-char beg)
- (insert header)
- (insert (format "Content-Type: %s\n" ctype))
- (if encoding
- (insert (format "Content-Transfer-Encoding: %s\n" encoding))
- )
- (insert "\n")
- (or (funcall (pgp-function 'encrypt)
- recipients (point-min) (point-max) from)
+ (narrow-to-region beg end)
+ (let* ((ret
+ (mime-edit-translate-region beg end boundary))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (pgp-boundary (concat "pgp-" boundary)))
+ (goto-char beg)
+ (insert header)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (eword-encode-header)
+ (or (let ((pgg-default-user-id
+ (or mime-edit-pgp-user-id
+ (if from
+ (nth 1 (std11-extract-address-components from))
+ pgg-default-user-id))))
+ (pgg-encrypt-region
+ (point-min) (point-max)
+ (mapcar (lambda (recipient)
+ (nth 1 (std11-extract-address-components
+ recipient)))
+ (split-string recipients
+ "\\([ \t\n]*,[ \t\n]*\\)+")))
+ )
(throw 'mime-edit-error 'pgp-error)
)
+ (delete-region (point-min)(point-max))
(goto-char beg)
(insert (format "--[[multipart/encrypted;
boundary=\"%s\";
Content-Transfer-Encoding: 7bit
" pgp-boundary pgp-boundary pgp-boundary))
+ (insert-buffer-substring pgg-output-buffer)
(goto-char (point-max))
(insert (format "\n--%s--\n" pgp-boundary))
)))))
(insert (format "Content-Transfer-Encoding: %s\n" encoding))
)
(insert "\n")
- (or (as-binary-process
- (funcall (pgp-function 'traditional-sign)
- beg (point-max)))
+ (or (pgg-sign-region beg (point-max) 'clearsign)
(throw 'mime-edit-error 'pgp-error)
)
(goto-char beg)
(insert (format "Content-Transfer-Encoding: %s\n" encoding))
)
(insert "\n")
- (or (as-binary-process
- (funcall (pgp-function 'encrypt)
- recipients beg (point-max) nil 'maybe)
- )
+ (or (pgg-encrypt-region beg (point-max) recipients)
(throw 'mime-edit-error 'pgp-error)
)
(goto-char beg)
))
)))
+(defun mime-edit-sign-smime (beg end boundary)
+ (save-excursion
+ (save-restriction
+ (let* ((ret (progn
+ (narrow-to-region beg end)
+ (mime-edit-translate-region beg end boundary)))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (smime-boundary (concat "smime-sign-" boundary)))
+ (goto-char beg)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (let (buffer-undo-list)
+ (goto-char (point-min))
+ (while (progn (end-of-line) (not (eobp)))
+ (insert "\r")
+ (forward-line 1))
+ (or (prog1 (smime-sign-region (point-min)(point-max))
+ (push nil buffer-undo-list)
+ (ignore-errors (undo)))
+ (throw 'mime-edit-error 'pgp-error)
+ ))
+ (goto-char beg)
+ (insert (format "--[[multipart/signed;
+ boundary=\"%s\"; micalg=sha1;
+ protocol=\"application/pkcs7-signature\"][7bit]]
+--%s
+" smime-boundary smime-boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s
+Content-Type: application/pkcs7-signature; name=\"smime.p7s\"
+Content-Transfer-Encoding: base64
+Content-Disposition: attachment; filename=\"smime.p7s\"
+Content-Description: S/MIME Cryptographic Signature
+
+" smime-boundary))
+ (insert-buffer-substring smime-output-buffer)
+ (goto-char (point-max))
+ (insert (format "\n--%s--\n" smime-boundary))
+ ))))
+
+(defun mime-edit-encrypt-smime (beg end boundary)
+ (save-excursion
+ (save-restriction
+ (let* ((ret (progn
+ (narrow-to-region beg end)
+ (mime-edit-translate-region beg end boundary)))
+ (ctype (car ret))
+ (encoding (nth 1 ret)))
+ (goto-char beg)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (goto-char (point-min))
+ (while (progn (end-of-line) (not (eobp)))
+ (insert "\r")
+ (forward-line 1))
+ (or (smime-encrypt-region (point-min)(point-max))
+ (throw 'mime-edit-error 'pgp-error)
+ )
+ (delete-region (point-min)(point-max))
+ (insert "--[[application/pkcs7-mime; name=\"smime.p7m\"
+Content-Disposition: attachment; filename=\"smime.p7m\"
+Content-Description: S/MIME Encrypted Message][base64]]\n")
+ (insert-buffer-substring smime-output-buffer)
+ ))))
+
(defsubst replace-space-with-underline (str)
(mapconcat (function
(lambda (arg)
(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)
)
(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
))
(if arg
(progn
- (setq mime-edit-pgp-processing 'sign)
+ (or (memq 'sign mime-edit-pgp-processing)
+ (setq mime-edit-pgp-processing
+ (nconc mime-edit-pgp-processing
+ (copy-sequence '(sign)))))
(message "This message will be signed.")
)
- (if (eq mime-edit-pgp-processing 'sign)
- (setq mime-edit-pgp-processing nil)
- )
+ (setq mime-edit-pgp-processing
+ (delq 'sign mime-edit-pgp-processing))
(message "This message will not be signed.")
))
))
(if arg
(progn
- (setq mime-edit-pgp-processing 'encrypt)
+ (or (memq 'encrypt mime-edit-pgp-processing)
+ (setq mime-edit-pgp-processing
+ (nconc mime-edit-pgp-processing
+ (copy-sequence '(encrypt)))))
(message "This message will be encrypt.")
)
- (if (eq mime-edit-pgp-processing 'encrypt)
- (setq mime-edit-pgp-processing nil)
- )
+ (setq mime-edit-pgp-processing
+ (delq 'encrypt mime-edit-pgp-processing))
(message "This message will not be encrypt.")
))
(if (search-forward (concat "\n" mail-header-separator "\n"))
(match-end 0)
)))
- (end (point-max))
)
(if beg
- (cond ((eq mime-edit-pgp-processing 'sign)
- (mime-edit-enclose-pgp-signed-region beg end)
- )
- ((eq mime-edit-pgp-processing 'encrypt)
- (mime-edit-enclose-pgp-encrypted-region beg end)
- ))
+ (dolist (pgp-processing mime-edit-pgp-processing)
+ (case pgp-processing
+ (sign
+ (mime-edit-enclose-pgp-signed-region
+ beg (point-max))
+ )
+ (encrypt
+ (mime-edit-enclose-pgp-encrypted-region
+ beg (point-max))
+ )))
)))
(buf-name (buffer-name))
(temp-buf-name (concat "*temp-article:" buf-name "*"))
(buf (get-buffer temp-buf-name))
+ (pgp-processing mime-edit-pgp-processing)
)
(if buf
(progn
(setq mail-header-separator separator)
(make-local-variable 'mime-edit-buffer)
(setq mime-edit-buffer the-buf)
+ (setq mime-edit-pgp-processing pgp-processing)
(run-hooks 'mime-edit-translate-hook)
(mime-edit-translate-buffer)
string))
(defun mime-edit-decode-multipart-in-buffer (content-type not-decode-text)
- (let* ((subtype (mime-content-type-subtype content-type))
+ (let* ((subtype
+ (or
+ (cdr (assoc (mime-content-type-parameter content-type "protocol")
+ '(("application/pgp-encrypted" . pgp-encrypted)
+ ("application/pgp-signature" . pgp-signed))))
+ (mime-content-type-subtype content-type)))
(boundary (mime-content-type-parameter content-type "boundary"))
(boundary-pat (concat "\n--" (regexp-quote boundary) "[ \t]*\n")))
(re-search-forward boundary-pat nil t)
)
(save-restriction
(narrow-to-region beg end)
- (mime-edit-decode-message-in-buffer
- (if (eq subtype 'digest)
- (eval-when-compile
- (make-mime-content-type 'message 'rfc822))
- )
- not-decode-text)
- (goto-char (point-max))
+ (cond
+ ((eq subtype 'pgp-encrypted)
+ (when (and
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP MESSAGE-+$"
+ nil t))
+ (prog1
+ (save-window-excursion
+ (pgg-decrypt-region (match-beginning 0)
+ (point-max)))
+ (delete-region (point-min)(point-max))))
+ (insert-buffer-substring pgg-output-buffer)
+ (mime-edit-decode-message-in-buffer
+ nil not-decode-text)
+ (delete-region (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (match-end 0)
+ (point-min)))
+ (goto-char (point-max))
+ ))
+ (t
+ (mime-edit-decode-message-in-buffer
+ (if (eq subtype 'digest)
+ (eval-when-compile
+ (make-mime-content-type 'message 'rfc822))
+ )
+ not-decode-text)
+ (goto-char (point-max))
+ ))
))))
))
(goto-char (point-min))
)))
))
-(defun mime-edit-decode-single-part-in-buffer (content-type not-decode-text)
+(defun mime-edit-decode-single-part-in-buffer
+ (content-type not-decode-text &optional content-disposition)
(let* ((type (mime-content-type-primary-type content-type))
(subtype (mime-content-type-subtype content-type))
(ctype (format "%s/%s" type subtype))
encoded
(limit (save-excursion
(if (search-forward "\n\n" nil t)
- (1- (point))))))
+ (1- (point)))))
+ (disposition-type
+ (mime-content-disposition-type content-disposition))
+ (disposition-str
+ (if disposition-type
+ (let ((bytes (+ 21 (length (format "%s" disposition-type)))))
+ (mapconcat (function
+ (lambda (attr)
+ (let* ((str (concat
+ (car attr)
+ "="
+ (if (string-equal "filename"
+ (car attr))
+ (std11-wrap-as-quoted-string
+ (cdr attr))
+ (cdr attr))))
+ (bs (length str)))
+ (setq bytes (+ bytes bs 2))
+ (if (< bytes 76)
+ (concat "; " str)
+ (setq bytes (+ bs 1))
+ (concat ";\n " str)
+ )
+ )))
+ (mime-content-disposition-parameters
+ content-disposition)
+ ""))))
+ )
+ (if disposition-type
+ (setq pstr (format "%s\nContent-Disposition: %s%s"
+ pstr disposition-type disposition-str))
+ )
(save-excursion
(if (re-search-forward
"^Content-Transfer-Encoding:" limit t)
(mime-edit-decode-multipart-in-buffer ctl not-decode-text)
)
(t
- (mime-edit-decode-single-part-in-buffer ctl not-decode-text)
+ (mime-edit-decode-single-part-in-buffer
+ ctl not-decode-text (mime-read-Content-Disposition))
)))
(or not-decode-text
(decode-mime-charset-region (point-min) (point-max)
default-mime-charset))
)
- (save-restriction
- (std11-narrow-to-header)
- (goto-char (point-min))
- (while (re-search-forward mime-edit-again-ignored-field-regexp nil t)
- (delete-region (match-beginning 0) (1+ (std11-field-end)))
- ))
- (mime-decode-header-in-buffer (not not-decode-text))
+ (if (= (point-min) 1)
+ (progn
+ (save-restriction
+ (std11-narrow-to-header)
+ (goto-char (point-min))
+ (while (re-search-forward
+ mime-edit-again-ignored-field-regexp nil t)
+ (delete-region (match-beginning 0) (1+ (std11-field-end)))
+ ))
+ (mime-decode-header-in-buffer (not not-decode-text))
+ ))
)))
;;;###autoload
;; Copyright (C) 1996 Dan Rich
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Dan Rich <drich@morpheus.corp.sgi.com>
+;; Dan Rich <drich@morpheus.corp.sgi.com>
+;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Created: 1995/12/15
;; Renamed: 1997/2/21 from tm-image.el
;;; Code:
+(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
-;;; 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 <morioka@jaist.ac.jp>
+;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
;; Created: 1995/12/7
;; Renamed: 1997/2/27 from tm-pgp.el
;; Keywords: PGP, security, MIME, multimedia, mail, news
;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
;; expired)
+;; [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
+;; Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
+;; <kazu@iijlab.net> (1998/1)
+
;;; Code:
(require 'mime-play)
+(require 'pgg-def)
+
+(autoload 'pgg-decrypt-region "pgg"
+ "PGP decryption of current region." t)
+(autoload 'pgg-verify-region "pgg"
+ "PGP verification of current region." t)
+(autoload 'pgg-snarf-keys-region "pgg"
+ "Snarf PGP public keys in current region." t)
+(autoload 'smime-decrypt-region "smime"
+ "S/MIME decryption of current region.")
+(autoload 'smime-verify-region "smime"
+ "S/MIME verification of current region.")
;;; @ Internal method for multipart/signed
(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)
(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)
((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."
(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))
;;; @ 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
;;;
(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)
;;;
(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))
))
</dd>
<kt>C-c C-x C-k
<kd>
-Insert <dref>PGP</dref> public key. (It requires Mailcrypt package.)
+Insert <dref>PGP</dref> public key.
</kd>
<kt>C-c C-x t
<kd>
features based on <concept>PGP/MIME</concept> (RFC 2015) or
<concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt).
<p>
-This feature requires pgp command and pgp interface package, such as
-<a file="mailcrypt">Mailcrypt package</a>.
+This feature requires your pgp command.
-<defvar name="pgp-function-alist">
+<defvar name="pgg-default-scheme">
<p>
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like <code>(SERVICE FUNCTION FILE)</code>.
-<p>
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt'
-or `insert-key'.
-<p>
-Function is a symbol of function to do specified SERVICE.
-<p>
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
</defvar>
-<defun name="pgp-function">
- <args> method
+<defvar name="pgg-scheme">
<p>
-Return function to do service <var>method</var>.
-</defun>
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
+</defvar>
<h2> Mouse button
features based on @strong{PGP/MIME} (RFC 2015) or @strong{PGP-kazu}
(draft-kazu-pgp-mime-00.txt).@refill
-This feature requires pgp command and pgp interface package, such as
-Mailcrypt package (@ref{(mailcrypt)}).
+This feature requires your pgp command.
-@defvar pgp-function-alist
+@defvar pgg-default-scheme
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like @code{(SERVICE FUNCTION FILE)}.@refill
-
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' or
-`insert-key'.@refill
-
-Function is a symbol of function to do specified SERVICE.@refill
-
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
@end defvar
-@defun pgp-function method
+@defvar pgg-scheme
-Return function to do service @var{method}.
-@end defun
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
+@end defvar
<concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&\e(B
\e$BEE;R=pL>!&8x3+80$NA^F~5!G=$rMxMQ$9$k$3$H$,$G$-$^$9!#\e(B
<p>
-
\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O
\e(B <a file="mailcrypt">Mailcrypt package</a>
-\e$B$H\e(B pgp command \e$B$,I,MW$G$9!#\e(B
+\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F<o\e(B pgp command \e$B$,I,MW$G$9!#\e(B
-<defvar name="pgp-function-alist">
+<defvar name="pgg-default-scheme">
<p>
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like <code>(SERVICE FUNCTION FILE)</code>.
-<p>
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt'
-or `insert-key'.
-<p>
-Function is a symbol of function to do specified SERVICE.
-<p>
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
</defvar>
-<defun name="pgp-function">
- <args> method
+<defvar name="pgg-scheme">
<p>
-Return function to do service <var>method</var>.
-</defun>
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are <code>gpg</code>,
+<code>pgp</code> or <code>pgp5</code>.
+</defvar>
<h2> \e$B2!KU\e(B
(draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&EE;R=pL>!&8x3+80$NA^F~5!G=$r\e(B
\e$BMxMQ$9$k$3$H$,$G$-$^$9!#\e(B@refill
-\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O\e(B Mailcrypt package (@ref{(mailcrypt)}) \e$B$H\e(B
-pgp command \e$B$,I,MW$G$9!#\e(B
+\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F<o\e(B pgp command \e$B$,I,MW$G$9!#\e(B
-@defvar pgp-function-alist
+@defvar pgg-default-scheme
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like @code{(SERVICE FUNCTION FILE)}.@refill
-
-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' or
-`insert-key'.@refill
-
-Function is a symbol of function to do specified SERVICE.@refill
-
-FILE is string of filename which has definition of corresponding
-FUNCTION.
+Version of PGP or GnuPG command to be used for encryption or sign.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
@end defvar
-@defun pgp-function method
+@defvar pgg-scheme
-Return function to do service @var{method}.
-@end defun
+Version of PGP or GnuPG command to be used for decryption or verification.
+The value should be a symbol. Allowed versions are @code{gpg},
+@code{pgp} or @code{pgp5}.@refill
+@end defvar
(ctree-set-calist-strictly
'mime-preview-condition
+ '((type . application)(subtype . x-postpet)
+ (body . visible)
+ (body-presentation-method . mime-display-application/x-postpet)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
'((type . text)(subtype . t)
(body . visible)
(body-presentation-method . mime-display-text/plain)))
(enriched-decode beg (point-max))
)))
+(put 'unpack 'lisp-indent-function 1)
+(defmacro unpack (string &rest body)
+ `(let* ((*unpack*string* (string-as-unibyte ,string))
+ (*unpack*index* 0))
+ ,@body))
+
+(defun unpack-skip (len)
+ (setq *unpack*index* (+ len *unpack*index*)))
+
+(defun unpack-fixed (len)
+ (prog1
+ (substring *unpack*string* *unpack*index* (+ *unpack*index* len))
+ (unpack-skip len)))
+
+(defun unpack-byte ()
+ (char-int (aref (unpack-fixed 1) 0)))
+
+(defun unpack-short ()
+ (let* ((b0 (unpack-byte))
+ (b1 (unpack-byte)))
+ (+ (* 256 b0) b1)))
+
+(defun unpack-long ()
+ (let* ((s0 (unpack-short))
+ (s1 (unpack-short)))
+ (+ (* 65536 s0) s1)))
+
+(defun unpack-string ()
+ (let ((len (unpack-byte)))
+ (unpack-fixed len)))
+
+(defun unpack-string-sjis ()
+ (decode-mime-charset-string (unpack-string) 'shift_jis))
+
+(defun postpet-decode (string)
+ (condition-case nil
+ (unpack string
+ (let (res)
+ (unpack-skip 4)
+ (set-alist 'res 'carryingcount (unpack-long))
+ (unpack-skip 8)
+ (set-alist 'res 'sentyear (unpack-short))
+ (set-alist 'res 'sentmonth (unpack-short))
+ (set-alist 'res 'sentday (unpack-short))
+ (unpack-skip 8)
+ (set-alist 'res 'petname (unpack-string-sjis))
+ (set-alist 'res 'owner (unpack-string-sjis))
+ (set-alist 'res 'pettype (unpack-fixed 4))
+ (set-alist 'res 'health (unpack-short))
+ (unpack-skip 2)
+ (set-alist 'res 'sex (unpack-long))
+ (unpack-skip 1)
+ (set-alist 'res 'brain (unpack-byte))
+ (unpack-skip 39)
+ (set-alist 'res 'happiness (unpack-byte))
+ (unpack-skip 14)
+ (set-alist 'res 'petbirthyear (unpack-short))
+ (set-alist 'res 'petbirthmonth (unpack-short))
+ (set-alist 'res 'petbirthday (unpack-short))
+ (unpack-skip 8)
+ (set-alist 'res 'from (unpack-string))
+ (unpack-skip 5)
+ (unpack-skip 160)
+ (unpack-skip 4)
+ (unpack-skip 8)
+ (unpack-skip 8)
+ (unpack-skip 26)
+ (set-alist 'res 'treasure (unpack-short))
+ (set-alist 'res 'money (unpack-long))
+ res))
+ (error nil)))
+
+(defun mime-display-application/x-postpet (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max)(point-max))
+ (let ((pet (postpet-decode (mime-entity-content entity))))
+ (if pet
+ (insert "Petname: " (cdr (assq 'petname pet)) "\n"
+ "Owner: " (cdr (assq 'owner pet)) "\n"
+ "Pettype: " (cdr (assq 'pettype pet)) "\n"
+ "From: " (cdr (assq 'from pet)) "\n"
+ "CarryingCount: " (int-to-string (cdr (assq 'carryingcount pet))) "\n"
+ "SentYear: " (int-to-string (cdr (assq 'sentyear pet))) "\n"
+ "SentMonth: " (int-to-string (cdr (assq 'sentmonth pet))) "\n"
+ "SentDay: " (int-to-string (cdr (assq 'sentday pet))) "\n"
+ "PetbirthYear: " (int-to-string (cdr (assq 'petbirthyear pet))) "\n"
+ "PetbirthMonth: " (int-to-string (cdr (assq 'petbirthmonth pet))) "\n"
+ "PetbirthDay: " (int-to-string (cdr (assq 'petbirthday pet))) "\n"
+ "Health: " (int-to-string (cdr (assq 'health pet))) "\n"
+ "Sex: " (int-to-string (cdr (assq 'sex pet))) "\n"
+ "Brain: " (int-to-string (cdr (assq 'brain pet))) "\n"
+ "Happiness: " (int-to-string (cdr (assq 'happiness pet))) "\n"
+ "Treasure: " (int-to-string (cdr (assq 'treasure pet))) "\n"
+ "Money: " (int-to-string (cdr (assq 'money pet))) "\n"
+ )
+ (insert "Invalid format\n"))
+ (run-hooks 'mime-display-application/x-postpet-hook))))
+
+
(defvar mime-view-announcement-for-message/partial
(if (and (>= emacs-major-version 19) window-system)
"\
(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])
))
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)))
(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"))
)))
--- /dev/null
+;;; pgg-def.el --- functions/macros for defining PGG functions
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'pcustom)
+
+(defgroup pgg ()
+ "Glue for the various PGP implementations."
+ :group 'mime)
+
+(defcustom pgg-default-scheme 'gpg
+ "Default PGP scheme"
+ :group '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
--- /dev/null
+;;; pgg-gpg.el --- GnuPG support for PGG.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; 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
--- /dev/null
+;;; pgg-parse.el --- OpenPGP packet parsing
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module is based on
+
+;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
+;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
+;; Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
+;; Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
+;; (1998/11)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(eval-when-compile (require 'static))
+
+(require 'poem)
+(require 'pccl)
+(require 'pcustom)
+(require 'mel)
+
+(defgroup pgg-parse ()
+ "OpenPGP packet parsing"
+ :group 'pgg)
+
+(defcustom pgg-parse-public-key-algorithm-alist
+ '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
+ "Alist of the assigned number to the public key algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-symmetric-key-algorithm-alist
+ '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
+ "Alist of the assigned number to the simmetric key algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-hash-algorithm-alist
+ '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
+ "Alist of the assigned number to the cryptographic hash algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-compression-algorithm-alist
+ '((0 . nil); Uncompressed
+ (1 . ZIP)
+ (2 . ZLIB))
+ "Alist of the assigned number to the compression algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-parse-signature-type-alist
+ '((0 . "Signature of a binary document")
+ (1 . "Signature of a canonical text document")
+ (2 . "Standalone signature")
+ (16 . "Generic certification of a User ID and Public Key packet")
+ (17 . "Persona certification of a User ID and Public Key packet")
+ (18 . "Casual certification of a User ID and Public Key packet")
+ (19 . "Positive certification of a User ID and Public Key packet")
+ (24 . "Subkey Binding Signature")
+ (31 . "Signature directly on a key")
+ (32 . "Key revocation signature")
+ (40 . "Subkey revocation signature")
+ (48 . "Certification revocation signature")
+ (64 . "Timestamp signature."))
+ "Alist of the assigned number to the signature type."
+ :group 'pgg-parse
+ :type 'alist)
+
+(defcustom pgg-ignore-packet-checksum t; XXX
+ "If non-nil checksum of each ascii armored packet will be ignored."
+ :group 'pgg-parse
+ :type 'boolean)
+
+(defvar pgg-armor-header-lines
+ '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP SIGNATURE-----\r?$")
+ "Armor headers")
+
+(defmacro pgg-format-key-identifier (string)
+ `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
+ (string-to-int-list ,string))))
+
+(defmacro pgg-parse-time-field (bytes)
+ `(list (logior (lsh (car ,bytes) 8)
+ (nth 1 ,bytes))
+ (logior (lsh (nth 2 ,bytes) 8)
+ (nth 3 ,bytes))
+ 0))
+
+(defmacro pgg-byte-after (&optional pos)
+ `(char-int (char-after ,(or pos `(point)))))
+
+(defmacro pgg-read-byte ()
+ `(char-int (char-after (prog1 (point) (forward-char)))))
+
+(defmacro pgg-read-bytes-string (nbytes)
+ `(buffer-substring
+ (point) (prog1 (+ ,nbytes (point))
+ (forward-char ,nbytes))))
+
+(defmacro pgg-read-bytes (nbytes)
+ `(string-to-int-list (pgg-read-bytes-string ,nbytes)))
+
+(defmacro pgg-read-body-string (ptag)
+ `(if (nth 1 ,ptag)
+ (pgg-read-bytes-string (nth 1 ,ptag))
+ (pgg-read-bytes-string (- (point-max) (point)))))
+
+(defmacro pgg-read-body (ptag)
+ `(string-to-int-list (pgg-read-body-string ,ptag)))
+
+(defalias 'pgg-skip-bytes 'forward-char)
+
+(defmacro pgg-skip-header (ptag)
+ `(pgg-skip-bytes (nth 2 ,ptag)))
+
+(defmacro pgg-skip-body (ptag)
+ `(pgg-skip-bytes (nth 1 ,ptag)))
+
+(defmacro pgg-set-alist (alist key value)
+ `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
+
+(unless-broken ccl-usable
+ (define-ccl-program pgg-parse-crc24
+ '(1
+ ((loop
+ (read r0) (r1 ^= r0) (r2 ^= 0)
+ (r5 = 0)
+ (loop
+ (r1 <<= 1)
+ (r1 += ((r2 >> 15) & 1))
+ (r2 <<= 1)
+ (if (r1 & 256)
+ ((r1 ^= 390) (r2 ^= 19707)))
+ (if (r5 < 7)
+ ((r5 += 1)
+ (repeat))))
+ (repeat)))))
+
+ (defun pgg-parse-crc24-string (string)
+ (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
+ (ccl-execute-on-string pgg-parse-crc24 h string)
+ (format "%c%c%c"
+ (logand (aref h 1) 255)
+ (logand (lsh (aref h 2) -8) 255)
+ (logand (aref h 2) 255))))
+ )
+
+(defmacro pgg-parse-length-type (c)
+ `(cond
+ ((< ,c 192) (cons ,c 1))
+ ((< ,c 224)
+ (cons (+ (lsh (- ,c 192) 8)
+ (pgg-byte-after (+ 2 (point)))
+ 192)
+ 2))
+ ((= ,c 255)
+ (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
+ (pgg-byte-after (+ 3 (point))))
+ (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
+ (pgg-byte-after (+ 5 (point)))))
+ 5))
+ (t;partial body length
+ '(0 . 0))))
+
+(defun pgg-parse-packet-header ()
+ (let ((ptag (pgg-byte-after))
+ length-type content-tag packet-bytes header-bytes)
+ (if (zerop (logand 64 ptag));Old format
+ (progn
+ (setq length-type (logand ptag 3)
+ length-type (if (= 3 length-type) 0 (lsh 1 length-type))
+ content-tag (logand 15 (lsh ptag -2))
+ packet-bytes 0
+ header-bytes (1+ length-type))
+ (dotimes (i length-type)
+ (setq packet-bytes
+ (logior (lsh packet-bytes 8)
+ (pgg-byte-after (+ 1 i (point))))))
+ )
+ (setq content-tag (logand 63 ptag)
+ length-type (pgg-parse-length-type
+ (pgg-byte-after (1+ (point))))
+ packet-bytes (car length-type)
+ header-bytes (1+ (cdr length-type))))
+ (list content-tag packet-bytes header-bytes)))
+
+(defun pgg-parse-packet (ptag)
+ (case (car ptag)
+ (1 ;Public-Key Encrypted Session Key Packet
+ (pgg-parse-public-key-encrypted-session-key-packet ptag))
+ (2 ;Signature Packet
+ (pgg-parse-signature-packet ptag))
+ (3 ;Symmetric-Key Encrypted Session Key Packet
+ (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
+ ;; 4 -- One-Pass Signature Packet
+ ;; 5 -- Secret Key Packet
+ (6 ;Public Key Packet
+ (pgg-parse-public-key-packet ptag))
+ ;; 7 -- Secret Subkey Packet
+ ;; 8 -- Compressed Data Packet
+ (9 ;Symmetrically Encrypted Data Packet
+ (pgg-read-body-string ptag))
+ (10 ;Marker Packet
+ (pgg-read-body-string ptag))
+ (11 ;Literal Data Packet
+ (pgg-read-body-string ptag))
+ ;; 12 -- Trust Packet
+ (13 ;User ID Packet
+ (pgg-read-body-string ptag))
+ ;; 14 -- Public Subkey Packet
+ ;; 60 .. 63 -- Private or Experimental Values
+ ))
+
+(defun pgg-parse-packets (&optional header-parser body-parser)
+ (let ((header-parser
+ (or header-parser
+ (function pgg-parse-packet-header)))
+ (body-parser
+ (or body-parser
+ (function pgg-parse-packet)))
+ result ptag)
+ (while (> (point-max) (1+ (point)))
+ (setq ptag (funcall header-parser))
+ (pgg-skip-header ptag)
+ (push (cons (car ptag)
+ (save-excursion
+ (funcall body-parser ptag)))
+ result)
+ (if (zerop (nth 1 ptag))
+ (goto-char (point-max))
+ (forward-char (nth 1 ptag))))
+ result))
+
+(defun pgg-parse-signature-subpacket-header ()
+ (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
+ (list (pgg-byte-after (+ (cdr length-type) (point)))
+ (1- (car length-type))
+ (1+ (cdr length-type)))))
+
+(defun pgg-parse-signature-subpacket (ptag)
+ (case (car ptag)
+ (2 ;signature creation time
+ (cons 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (3 ;signature expiration time
+ (cons 'signature-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (4 ;exportable certification
+ (cons 'exportability (pgg-read-byte)))
+ (5 ;trust signature
+ (cons 'trust-level (pgg-read-byte)))
+ (6 ;regular expression
+ (cons 'regular-expression
+ (pgg-read-body-string ptag)))
+ (7 ;revocable
+ (cons 'revocability (pgg-read-byte)))
+ (9 ;key expiration time
+ (cons 'key-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ ;; 10 = placeholder for backward compatibility
+ (11 ;preferred symmetric algorithms
+ (cons 'preferred-symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist))))
+ (12 ;revocation key
+ )
+ (16 ;issuer key ID
+ (cons 'key-identifier
+ (pgg-format-key-identifier (pgg-read-body-string ptag))))
+ (20 ;notation data
+ (pgg-skip-bytes 4)
+ (cons 'notation
+ (let ((name-bytes (pgg-read-bytes 2))
+ (value-bytes (pgg-read-bytes 2)))
+ (cons (pgg-read-bytes-string
+ (logior (lsh (car name-bytes) 8)
+ (nth 1 name-bytes)))
+ (pgg-read-bytes-string
+ (logior (lsh (car value-bytes) 8)
+ (nth 1 value-bytes))))))
+ )
+ (21 ;preferred hash algorithms
+ (cons 'preferred-hash-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-hash-algorithm-alist))))
+ (22 ;preferred compression algorithms
+ (cons 'preferred-compression-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-compression-algorithm-alist))))
+ (23 ;key server preferences
+ (cons 'key-server-preferences
+ (pgg-read-body ptag)))
+ (24 ;preferred key server
+ (cons 'preferred-key-server
+ (pgg-read-body-string ptag)))
+ ;; 25 = primary user id
+ (26 ;policy URL
+ (cons 'policy-url (pgg-read-body-string ptag)))
+ ;; 27 = key flags
+ ;; 28 = signer's user id
+ ;; 29 = reason for revocation
+ ;; 100 to 110 = internal or user-defined
+ ))
+
+(defun pgg-parse-signature-packet (ptag)
+ (let* ((signature-version (pgg-byte-after))
+ (result (list (cons 'version signature-version)))
+ hashed-material field n)
+ (cond
+ ((= signature-version 3)
+ (pgg-skip-bytes 2)
+ (setq hashed-material (pgg-read-bytes 5))
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pop hashed-material)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'creation-time
+ (pgg-parse-time-field hashed-material))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte))
+ )
+ ((= signature-version 4)
+ (pgg-skip-bytes 1)
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))
+ (goto-char (point-max)))
+ )
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))
+ ))
+ ))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ (setcdr (setq field (assq 'hash-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-hash-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version (pgg-read-byte))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-packet (ptag)
+ (let* ((key-version (pgg-read-byte))
+ (result (list (cons 'version key-version)))
+ field)
+ (cond
+ ((= 3 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'key-expiry (pgg-read-bytes 2))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))
+ )
+ ((= 4 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))
+ ))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-decode-packets ()
+ (let* ((marker
+ (set-marker (make-marker)
+ (and (re-search-forward "^=")
+ (match-beginning 0))))
+ (checksum (buffer-substring (point) (+ 4 (point)))))
+ (delete-region marker (point-max))
+ (mime-decode-region (point-min) marker "base64")
+ (static-when (fboundp 'pgg-parse-crc24-string )
+ (or pgg-ignore-packet-checksum
+ (string-equal
+ (funcall (mel-find-function 'mime-encode-string "base64")
+ (pgg-parse-crc24-string
+ (buffer-substring (point-min)(point-max))))
+ checksum)
+ (error "PGP packet checksum does not match.")))))
+
+(defun pgg-decode-armor-region (start end)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP" nil t)
+ (delete-region (point-min)
+ (and (search-forward "\n\n")
+ (match-end 0)))
+ (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets)))
+
+(defun pgg-parse-armor (string)
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (set-buffer-multibyte nil)
+ (insert string)
+ (pgg-decode-armor-region (point-min)(point))))
+
+(defun pgg-parse-armor-region (start end)
+ (pgg-parse-armor (string-as-unibyte (buffer-substring start end))))
+
+(provide 'pgg-parse)
+
+;;; pgg-parse.el ends here
--- /dev/null
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp ()
+ "PGP 2.* and 6.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp-program "pgp"
+ "PGP 2.* and 6.* executable."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-file-name "/bin/sh"
+ "File name to load inferior shells from. Bourne shell or its equivalent
+\(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-extra-args nil
+ "Extra arguments for every PGP invocation."
+ :group 'pgg-pgp
+ :type 'string)
+
+(eval-and-compile
+ (luna-define-class pgg-scheme-pgp (pgg-scheme))
+ )
+
+(defvar pgg-pgp-user-id nil
+ "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
--- /dev/null
+;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp5 ()
+ "PGP 5.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp5-pgpe-program "pgpe"
+ "PGP 5.* 'pgpe' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgps-program "pgps"
+ "PGP 5.* 'pgps' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpk-program "pgpk"
+ "PGP 5.* 'pgpk' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpv-program "pgpv"
+ "PGP 5.* 'pgpv' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-file-name "/bin/sh"
+ "File name to load inferior shells from. Bourne shell or its equivalent
+\(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-extra-args nil
+ "Extra arguments for every PGP 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
--- /dev/null
+;;; pgg.el --- glue for the various PGP implementations.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'calist)
+
+(eval-and-compile (require 'luna))
+
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(eval-when-compile
+ (ignore-errors
+ (require 'w3)
+ (require 'url)))
+
+(in-calist-package 'pgg)
+
+(defun pgg-field-match-method-with-containment
+ (calist field-type field-value)
+ (let ((s-field (assq field-type calist)))
+ (cond ((null s-field)
+ (cons (cons field-type field-value) calist)
+ )
+ ((memq (cdr s-field) field-value)
+ calist))))
+
+(define-calist-field-match-method 'signature-version
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'symmetric-key-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'public-key-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'hash-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(defvar pgg-verify-condition nil
+ "Condition-tree about which PGP implementation is used for verifying.")
+
+(defvar pgg-decrypt-condition nil
+ "Condition-tree about which PGP implementation is used for decrypting.")
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3)(public-key-algorithm RSA)(hash-algorithm MD5)
+ (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm RSA)(symmetric-key-algorithm IDEA)
+ (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3 4)
+ (public-key-algorithm RSA ELG DSA)
+ (hash-algorithm MD5 SHA1 RIPEMD160)
+ (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm RSA ELG DSA)
+ (symmetric-key-algorithm 3DES CAST5 IDEA)
+ (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3 4)
+ (public-key-algorithm ELG-E DSA ELG)
+ (hash-algorithm MD5 SHA1 RIPEMD160)
+ (scheme . gpg)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm ELG-E DSA ELG)
+ (symmetric-key-algorithm 3DES CAST5 BLOWFISH TWOFISH)
+ (scheme . gpg)))
+
+;;; @ definition of the implementation scheme
+;;;
+
+(eval-and-compile
+ (luna-define-class pgg-scheme ())
+
+ (luna-define-internal-accessors 'pgg-scheme)
+ )
+
+(luna-define-generic 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
(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"
)
-;;; @ 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
;;;
;; for PGP
-(defvar mime-setup-enable-pgp
- (module-installed-p 'mailcrypt)
+(defvar mime-setup-enable-pgp t
"*If it is non-nil, semi-setup sets uf to use mime-pgp.")
(if mime-setup-enable-pgp
'((type . application)(subtype . pgp-keys)
(method . mime-add-application/pgp-keys))
'strict "mime-pgp")
+
+ (mime-add-condition
+ 'action
+ '((type . application)(subtype . pkcs7-signature)
+ (method . mime-verify-application/pkcs7-signature))
+ 'strict "mime-pgp")
+
+ (mime-add-condition
+ 'action
+ '((type . application)(subtype . x-pkcs7-signature)
+ (method . mime-verify-application/pkcs7-signature))
+ 'strict "mime-pgp")
+
+ (mime-add-condition
+ 'action
+ '((type . application)(subtype . pkcs7-mime)
+ (method . mime-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")
))
)
--- /dev/null
+;;; smime.el --- S/MIME interface.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/12/08
+;; Keywords: S/MIME, OpenSSL
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;; This module is based on
+
+;; [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"
+;; by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,
+;; Pawling, J. and Schaad, J. (1999/06)
+
+;; [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"
+;; by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.
+;; and L. Repka. (1998/03)
+
+;;; Code:
+
+(require 'path-util)
+(eval-when-compile (require 'static))
+
+(defgroup smime ()
+ "S/MIME interface"
+ :group 'mime)
+
+(defcustom smime-program "smime"
+ "The S/MIME executable."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-shell-file-name "/bin/sh"
+ "File name to load inferior shells from. Bourne shell or its equivalent
+\(not tcsh) is needed for \"2>\"."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-x509-program
+ (let ((file (exec-installed-p "openssl")))
+ (and file (list file "x509" "-noout")))
+ "External program for x509 parser."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-cache-passphrase t
+ "Cache passphrase."
+ :group 'smime
+ :type 'boolean)
+
+(defcustom smime-certificate-directory "~/.w3/certs"
+ "Certificate directory."
+ :group 'smime
+ :type 'directory)
+
+(defcustom smime-public-key-file nil
+ "Public key file."
+ :group 'smime
+ :type 'boolean)
+
+(defcustom smime-private-key-file nil
+ "Private key file."
+ :group 'smime
+ :type 'boolean)
+
+(defvar smime-errors-buffer " *S/MIME errors*")
+(defvar smime-output-buffer " *S/MIME output*")
+
+;;; @ utility functions
+;;;
+(put 'smime-process-when-success 'lisp-indent-function 0)
+
+(defmacro smime-process-when-success (&rest body)
+ `(with-current-buffer smime-output-buffer
+ (if (zerop (buffer-size)) nil ,@body t)))
+
+(defvar smime-passphrase-cache-expiry 16)
+(defvar smime-passphrase-cache (make-vector 7 0))
+
+(defvar smime-read-passphrase nil)
+(defun smime-read-passphrase (prompt &optional key)
+ (if (not smime-read-passphrase)
+ (if (functionp 'read-passwd)
+ (setq smime-read-passphrase 'read-passwd)
+ (if (load "passwd" t)
+ (setq smime-read-passphrase 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq smime-read-passphrase 'ange-ftp-read-passwd))))
+ (or (and smime-cache-passphrase
+ (symbol-value (intern-soft key smime-passphrase-cache)))
+ (funcall smime-read-passphrase prompt)))
+
+(defun smime-add-passphrase-cache (key passphrase)
+ (set (intern key smime-passphrase-cache)
+ passphrase)
+ (run-at-time smime-passphrase-cache-expiry nil
+ #'smime-remove-passphrase-cache
+ key))
+
+(defun smime-remove-passphrase-cache (key)
+ (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
+ (when passphrase
+ (fillarray passphrase ?_)
+ (unintern key smime-passphrase-cache))))
+
+(defsubst smime-parse-attribute (string)
+ (delq nil (mapcar
+ (lambda (attr)
+ (if (string-match "=" attr)
+ (cons (intern (substring attr 0 (match-beginning 0)))
+ (substring attr (match-end 0)))
+ nil))
+ (split-string string "/"))))
+
+(defsubst smime-query-signer (start end)
+ (smime-process-region start end smime-program (list "-qs"))
+ (with-current-buffer smime-output-buffer
+ (if (zerop (buffer-size)) nil
+ (goto-char (point-min))
+ (when (re-search-forward "^/" nil t)
+ (smime-parse-attribute
+ (buffer-substring (point) (progn (end-of-line)(point)))))
+ )))
+
+(defsubst smime-x509-hash (cert-file)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process (car smime-x509-program) nil t nil
+ (append (cdr smime-x509-program)
+ (list "-hash" "-in" cert-file)))
+ (if (zerop (buffer-size)) nil
+ (buffer-substring (point-min) (1- (point-max))))))
+
+(defsubst smime-x509-subject (cert-file)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process (car smime-x509-program) nil t nil
+ (append (cdr smime-x509-program)
+ (list "-subject" "-in" cert-file)))
+ (if (zerop (buffer-size)) nil
+ (goto-char (point-min))
+ (when (re-search-forward "^subject=" nil t)
+ (smime-parse-attribute
+ (buffer-substring (point)(progn (end-of-line)(point))))))))
+
+(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
projects / elisp / semi.git / commitdiff