From: yamaoka Date: Sun, 28 May 2000 22:34:47 +0000 (+0000) Subject: Sync X-Git-Tag: t-gnus-6_14-quimby-before-AC-changed-~37 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=2635fbbcd4b8dca39a3db3ce7aec78244028f931;p=elisp%2Fgnus.git- Sync with `t-gnus-6_14' and Gnus. --- diff --git a/ChangeLog b/ChangeLog index f88d85f..d4f5c32 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2000-05-28 TSUCHIYA Masatoshi + + * nnshimbun.el (nnshimbun-request-article-1): Fix to insert x-face + unless SERVER. + (nnshimbun-asahi-get-headers): Fix for subjects which contain ^M. + 2000-05-26 TSUCHIYA Masatoshi * lisp/nnshimbun.el (nnshimbun-write-nov): New function. diff --git a/contrib/rfc2015.el b/contrib/rfc2015.el new file mode 100644 index 0000000..065d07d --- /dev/null +++ b/contrib/rfc2015.el @@ -0,0 +1,183 @@ +;;; rfc2015.el --- MIME Security with Pretty Good Privacy (PGP) +;; Copyright (c) 2000 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu +;; Keywords: PGP MIME + +;; This file is a part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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: + +;; Usage: +;; (rfc2015-setup) +;; +;; Insert an attribute, postprocess=pgp-sign (or pgp-encrypt), into +;; the mml tag to be signed (or encrypted). + +;;; Code: + +(defvar rfc2015-decrypt-function 'mailcrypt-decrypt) +(defvar rfc2015-verify-function 'mailcrypt-verify) + +(defun rfc2015-decrypt (handle) + (let (child) + (cond + ((setq child (mm-find-part-by-type (cdr handle) + "application/octet-stream")) + (let (handles result) + (with-temp-buffer + (mm-insert-part child) + (setq result (funcall rfc2015-decrypt-function)) + (unless (car result) + (error "Decrypting error.")) + (setq handles (mm-dissect-buffer t))) + (setq gnus-article-mime-handles + (append (if (listp (car gnus-article-mime-handles)) + gnus-article-mime-handles + (list gnus-article-mime-handles)) + (if (listp (car handles)) + handles + (list handles)))) + (gnus-mime-display-part handles))) + (t + (if (y-or-n-p "Corrupted pgp-encrypted part. Abort?" ) + (error "Corrupted pgp-encrypted part.") + (gnus-mime-display-mixed (cdr handle))))))) + +;; FIXME: mm-dissect-buffer loses information of micalg and the +;; original header of signed part. + +(defun rfc2015-verify (handle) + (if (y-or-n-p "Verify signed part?" ) + (let (child result hash) + (with-temp-buffer + (unless (setq child (mm-find-part-by-type + (cdr handle) "application/pgp-signature" t)) + (error "Corrupted pgp-signature part.")) + (insert "-----BEGIN PGP SIGNED MESSAGE-----\n") + (insert (format "Hash: %s\n\n" (read-string "Hash: " "SHA1"))) + (mm-insert-part child) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (unless (setq child (mm-find-part-by-type + (cdr handle) "application/pgp-signature")) + (error "Corrupted pgp-signature part.")) + (mm-insert-part child) + (setq result (funcall rfc2015-verify-function)) + (unless result + (error "Verify error."))))) + (gnus-mime-display-part + (mm-find-part-by-type + (cdr handle) "application/pgp-signature" t))) + +(defvar rfc2015-mailcrypt-prefix 0) + +(defun rfc2015-mailcrypt-sign (cont) + (mailcrypt-sign rfc2015-mailcrypt-prefix) + (let ((boundary + (funcall mml-boundary-function (incf mml-multipart-number))) + (scheme-alist (funcall (or mc-default-scheme + (cdr (car mc-schemes))))) + hash) + (goto-char (point-min)) + (unless (re-search-forward (cdr (assq 'signed-begin-line scheme-alist))) + (error "Cannot find signed begin line." )) + (goto-char (match-beginning 0)) + (forward-line 1) + (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)") + (error "Cannot not find PGP hash." )) + (setq hash (match-string 1)) + (unless (re-search-forward "^$" nil t) + (error "Cannot not find PGP message." )) + (forward-line 1) + (delete-region (point-min) (point)) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n" + hash)) + (insert "\n") + (insert (format "--%s\n" boundary)) + (unless (re-search-forward (cdr (assq 'signed-end-line scheme-alist))) + (error "Cannot find signature part." )) + (goto-char (match-beginning 0)) + (unless (re-search-backward "^-+BEGIN" nil t) + (error "Cannot find signature part." )) + (goto-char (match-beginning 0)) + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-signature\n\n") + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + +(defun rfc2015-mailcrypt-encrypt (cont) + ;; FIXME: + ;; You have to input the receiptant. + (mailcrypt-encrypt rfc2015-mailcrypt-prefix) + (let ((boundary + (funcall mml-boundary-function (incf mml-multipart-number)))) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" + boundary)) + (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-encrypted\n\n") + (insert "Version: 1\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/octet-stream\n\n") + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + +;; The following code might be moved into mml.el or gnus-art.el. + +(defvar mml-postprocess-alist + '(("pgp-sign" . rfc2015-mailcrypt-sign) + ("pgp-encrypt" . rfc2015-mailcrypt-encrypt)) + "Alist of postprocess functions.") + +(defun mml-postprocess (cont) + (let ((pp (cdr (or (assq 'postprocess cont) + (assq 'pp cont)))) + item) + (if (and pp (setq item (assoc pp mml-postprocess-alist))) + (funcall (cdr item) cont)))) + +(defun rfc2015-setup () + (setq mml-generate-mime-postprocess-function 'mml-postprocess) +; (push '("multipart/signed" . rfc2015-verify) +; gnus-mime-multipart-functions) + (push '("multipart/encrypted" . rfc2015-decrypt) + gnus-mime-multipart-functions)) + +;; The following code might be moved into mm-decode.el. + +(defun mm-find-part-by-type (handles type &optional notp) + (let (handle) + (while handles + (if (if notp + (not (equal (mm-handle-media-type (car handles)) type)) + (equal (mm-handle-media-type (car handles)) type)) + (setq handle (car handles) + handles nil)) + (setq handles (cdr handles))) + handle)) + +(provide 'rfc2015) + +;;; rfc2015.el ends here diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el index ed60a93..71a9e8d 100644 --- a/lisp/nnshimbun.el +++ b/lisp/nnshimbun.el @@ -295,7 +295,9 @@ (and (nnheader-find-nov-line article) (nnheader-parse-nov)))) (let* ((xref (substring (mail-header-xref header) 6)) - (x-faces (cdr (or (assoc server nnshimbun-x-face-alist) + (x-faces (cdr (or (assoc (or server + (nnoo-current-server 'nnshimbun)) + nnshimbun-x-face-alist) (assoc "default" nnshimbun-x-face-alist)))) (x-face (cdr (or (assoc group x-faces) (assoc "default" x-faces))))) @@ -785,7 +787,7 @@ is enclosed by at least one regexp grouping construct." (buffer-substring (match-end 0) (progn (search-forward "
" nil t) (point))) - "<[^>]+>") + "\\(<[^>]+>\\|\r\\)") "")) nnshimbun-from-address "" id "" 0 0 (concat nnshimbun-url url))