+2000-11-30 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-add-text-properties-when): New function.
+ (gnus-remove-text-properties-when): Ditto.
+
+ * gnus-cite.el (gnus-article-hide-citation): Use them.
+ (gnus-article-toggle-cited-text): Use them.
+
+ * gnus-art.el (gnus-signature-toggle): Use them.
+ (gnus-article-show-hidden-text): Ditto.
+ (gnus-article-hide-text): Ditto.
+
+2000-11-30 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-find-charset-region): Remove eight-bit-*.
+
+2000-11-30 Simon Josefsson <sj@extundo.com>
+
+ * smime.el (smime-point-at-eol): New alias.
+ (smime-buffer-as-string-region): Use it.
+
+2000-11-29 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndraft.el (nndraft-request-restore-buffer): Remove Date field.
+
+2000-11-29 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-expire-articles): expiry-target.
+
+ * nnbabyl.el (nnbabyl-request-expire-articles): Ditto.
+
+ * nnmbox.el (nnmbox-request-expire-articles): Ditto.
+
+2000-11-22 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * nnmh.el (nnmh-request-expire-articles): Implemented
+ expiry-target for nnmh backend.
+
+2000-11-30 Simon Josefsson <sj@extundo.com>
+
+ * mm-decode.el (mm-security-from): New variable.
+ (mm-possibly-verify-or-decrypt): Use it rather than `from'.
+
+ * mml-smime.el (mml-smime-verify): Use `mm-security-from' rather
+ than `from'.
+
+2000-11-30 Simon Josefsson <sj@extundo.com>
+
+ * mml-smime.el (mml-smime-verify): Verify that certificate mail
+ address match sender address.
+
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address.
+
+ * smime.el (smime-verify-region): Don't copy buffer.
+ (smime-decrypt-buffer): Use expand-file-name on keyfile.
+ (smime-pkcs7-region): New function.
+ (smime-pkcs7-certificates-region): Ditto.
+ (smime-pkcs7-email-region): Ditto.
+ (smime-buffer-as-string-region): Ditto.
+
+ * gnus-art.el (gnus-mime-security-show-details): Goto beginning of
+ buffer.
+
+2000-11-23 Jens Krinke <j.krinke@gmx.de>
+
+ * smime.el (smime-decrypt-region): Fix keyfile argument.
+
2000-11-29 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* nnmail.el (nnmail-cache-accepted-message-ids): Add doc.
(defsubst gnus-article-hide-text (b e props)
"Set text PROPS on the B to E region, extending `intangible' 1 past B."
- (add-text-properties b e props)
+ (gnus-add-text-properties-when 'article-type nil b e props)
(when (memq 'intangible props)
(put-text-property
(max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
+
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
(remove-text-properties b e gnus-hidden-properties)
'hidden
nil)))
-(defun gnus-article-show-hidden-text (type &optional hide)
+(defun gnus-article-show-hidden-text (type &optional dummy)
"Show all hidden text of type TYPE.
-If HIDE, hide the text instead."
- (save-excursion
- (let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (end (point-min))
- beg)
- (while (setq beg (text-property-any end (point-max) 'article-type type))
- (goto-char beg)
- (setq end (or
- (text-property-not-all beg (point-max) 'article-type type)
- (point-max)))
- (if hide
- (gnus-article-hide-text beg end gnus-hidden-properties)
- (gnus-article-unhide-text beg end))
- (goto-char end))
- t)))
+Originally it is hide instead of DUMMY."
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t))
+ (gnus-remove-text-properties-when
+ 'article-type type
+ (point-min) (point-max)
+ (cons 'article-type (cons type
+ gnus-hidden-properties)))))
(defconst article-time-units
`((year . ,(* 365.25 24 60 60))
(inhibit-point-motion-hooks t)
(limit (next-single-property-change end 'mime-view-entity
nil (point-max))))
- (if (get-text-property end 'invisible)
- (gnus-article-unhide-text end limit)
- (gnus-article-hide-text end limit gnus-hidden-properties)))))
+ (if (text-property-any end limit 'article-type 'signature)
+ (gnus-remove-text-properties-when
+ 'article-type 'signature end limit
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties)))
+ (gnus-add-text-properties-when
+ 'article-type nil end limit
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties)))))))
(defun gnus-button-entry ()
;; Return the first entry in `gnus-button-alist' matching this place.
(setq gnus-mime-security-details-buffer
(gnus-get-buffer-create "*MIME Security Details*")))
(with-current-buffer gnus-mime-security-details-buffer
- (insert details))
+ (insert details)
+ (goto-char (point-min)))
(pop-to-buffer gnus-mime-security-details-buffer))
(gnus-message 5 "No details."))))
(gnus-set-format 'cited-closed-text-button t)
(save-excursion
(set-buffer gnus-article-buffer)
- (cond
- ((gnus-article-check-hidden-text 'cite arg)
- t)
- ((gnus-article-text-type-exists-p 'cite)
- (let ((buffer-read-only nil))
- (gnus-article-hide-text-of-type 'cite)))
- (t
(let ((buffer-read-only nil)
- (marks (gnus-dissect-cited-text))
+ marks
(inhibit-point-motion-hooks t)
(props (nconc (list 'article-type 'cite)
gnus-hidden-properties))
- beg end start)
- (while marks
- (setq beg nil
- end nil)
- (while (and marks (string= (cdar marks) ""))
- (setq marks (cdr marks)))
- (when marks
- (setq beg (caar marks)))
- (while (and marks (not (string= (cdar marks) "")))
- (setq marks (cdr marks)))
- (when marks
+ (point (point-min))
+ found beg end start)
+ (while (setq point
+ (text-property-any point (point-max)
+ 'gnus-callback
+ 'gnus-article-toggle-cited-text))
+ (setq found t)
+ (goto-char point)
+ (gnus-article-toggle-cited-text
+ (get-text-property point 'gnus-data) arg)
+ (forward-line 1)
+ (setq point (point)))
+ (unless found
+ (setq marks (gnus-dissect-cited-text))
+ (while marks
+ (setq beg nil
+ end nil)
+ (while (and marks (string= (cdar marks) ""))
+ (setq marks (cdr marks)))
+ (when marks
+ (setq beg (caar marks)))
+ (while (and marks (not (string= (cdar marks) "")))
+ (setq marks (cdr marks)))
+ (when marks
(setq end (caar marks)))
- ;; Skip past lines we want to leave visible.
- (when (and beg end gnus-cited-lines-visible)
- (goto-char beg)
- (forward-line (if (consp gnus-cited-lines-visible)
- (car gnus-cited-lines-visible)
- gnus-cited-lines-visible))
- (if (>= (point) end)
- (setq beg nil)
- (setq beg (point-marker))
- (when (consp gnus-cited-lines-visible)
- (goto-char end)
- (forward-line (- (cdr gnus-cited-lines-visible)))
- (if (<= (point) beg)
- (setq beg nil)
+ ;; Skip past lines we want to leave visible.
+ (when (and beg end gnus-cited-lines-visible)
+ (goto-char beg)
+ (forward-line (if (consp gnus-cited-lines-visible)
+ (car gnus-cited-lines-visible)
+ gnus-cited-lines-visible))
+ (if (>= (point) end)
+ (setq beg nil)
+ (setq beg (point-marker))
+ (when (consp gnus-cited-lines-visible)
+ (goto-char end)
+ (forward-line (- (cdr gnus-cited-lines-visible)))
+ (if (<= (point) beg)
+ (setq beg nil)
(setq end (point-marker))))))
- (when (and beg end)
- ;; We use markers for the end-points to facilitate later
- ;; wrapping and mangling of text.
- (setq beg (set-marker (make-marker) beg)
- end (set-marker (make-marker) end))
- (gnus-add-text-properties beg end props)
- (goto-char beg)
- (unless (save-excursion (search-backward "\n\n" nil t))
- (insert "\n"))
- (put-text-property
- (setq start (point-marker))
- (progn
+ (when (and beg end)
+ ;; We use markers for the end-points to facilitate later
+ ;; wrapping and mangling of text.
+ (setq beg (set-marker (make-marker) beg)
+ end (set-marker (make-marker) end))
+ (gnus-add-text-properties-when 'article-type nil beg end props)
+ (goto-char beg)
+ (unless (save-excursion (search-backward "\n\n" nil t))
+ (insert "\n"))
+ (put-text-property
+ (setq start (point-marker))
+ (progn
(gnus-article-add-button
(point)
(progn (eval gnus-cited-closed-text-button-line-format-spec)
`gnus-article-toggle-cited-text
(list (cons beg end) start))
(point))
- 'article-type 'annotation)
- (set-marker beg (point)))))))))
+ 'article-type 'annotation)
+ (set-marker beg (point))))))))
-(defun gnus-article-toggle-cited-text (args)
- "Toggle hiding the text in REGION."
+(defun gnus-article-toggle-cited-text (args &optional arg)
+ "Toggle hiding the text in REGION.
+ARG can be nil or a number. Positive means hide, negative
+means show, nil means toggle."
(let* ((region (car args))
(beg (car region))
(end (cdr region))
(start (cadr args))
(hidden
- (text-property-any
- beg (1- end)
- (car gnus-hidden-properties) (cadr gnus-hidden-properties)))
+ (text-property-any beg (1- end) 'article-type 'cite))
(inhibit-point-motion-hooks t)
buffer-read-only)
- (funcall
- (if hidden
- 'remove-text-properties 'gnus-add-text-properties)
- beg end gnus-hidden-properties)
- (save-excursion
- (goto-char start)
- (gnus-delete-line)
- (put-text-property
- (point)
- (progn
- (gnus-article-add-button
- (point)
- (progn (eval
- (if hidden
- gnus-cited-opened-text-button-line-format-spec
- gnus-cited-closed-text-button-line-format-spec))
- (point))
- `gnus-article-toggle-cited-text
- args)
- (point))
- 'article-type 'annotation))))
+ (when (or (null arg)
+ (zerop arg)
+ (and (> arg 0) (not hidden))
+ (and (< arg 0) hidden))
+ (if hidden
+ (gnus-remove-text-properties-when
+ 'article-type 'cite beg end
+ (cons 'article-type (cons 'cite
+ gnus-hidden-properties)))
+ (gnus-add-text-properties-when
+ 'article-type nil beg end
+ (cons 'article-type (cons 'cite
+ gnus-hidden-properties))))
+ (save-excursion
+ (goto-char start)
+ (gnus-delete-line)
+ (put-text-property
+ (point)
+ (progn
+ (gnus-article-add-button
+ (point)
+ (progn (eval
+ (if hidden
+ gnus-cited-opened-text-button-line-format-spec
+ gnus-cited-closed-text-button-line-format-spec))
+ (point))
+ `gnus-article-toggle-cited-text
+ args)
+ (point))
+ 'article-type 'annotation)))))
(defun gnus-article-hide-citation-maybe (&optional arg force)
"Toggle hiding of cited text that has an attribution line.
(pop l2))
l1))))
+(defun gnus-add-text-properties-when
+ (property value start end properties &optional object)
+ "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE."
+ (let (point)
+ (while (and start
+ (setq point (text-property-not-all start end property value)))
+ (gnus-add-text-properties start point properties object)
+ (setq start (text-property-any point end property value)))
+ (if start
+ (gnus-add-text-properties start end properties object))))
+
+(defun gnus-remove-text-properties-when
+ (property value start end properties &optional object)
+ "Like `remove-text-properties', only applied on where PROPERTY is VALUE."
+ (let (point)
+ (while (and start
+ (setq point (text-property-not-all start end property value)))
+ (remove-text-properties start point properties object)
+ (setq start (text-property-any point end property value)))
+ (if start
+ (remove-text-properties start end properties object))))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
result))
(defvar mm-security-handle nil)
+(defvar mm-security-from nil)
(defsubst mm-set-handle-multipart-parameter (handle parameter value)
;; HANDLE could be a CTL.
(defun mm-possibly-verify-or-decrypt (parts ctl)
(let ((subtype (cadr (split-string (car ctl) "/")))
(mm-security-handle ctl) ;; (car CTL) is the type.
+ (mm-security-from
+ (save-restriction
+ (mail-narrow-to-head)
+ (cadr (funcall gnus-extract-address-components
+ (or (mail-fetch-field "from") "")))))
protocol func functest)
(cond
((equal subtype "signed")
((and (mm-multibyte-p)
(fboundp 'find-charset-region))
;; Remove composition since the base charsets have been included.
- (delq 'composition (find-charset-region b e)))
+ ;; Remove eight-bit-*, treat them as ascii.
+ (let ((css (find-charset-region b e)))
+ (mapcar (lambda (cs) (setq css (delq cs css)))
+ '(composition eight-bit-control eight-bit-graphic))
+ css))
(t
;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
(save-excursion
(when (get-buffer smime-details-buffer)
(kill-buffer smime-details-buffer))
(if (smime-verify-buffer)
- (progn
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK")
- (kill-buffer smime-details-buffer))
+ ;; verify mail addresses in mail against those in certificate
+ (when (and (smime-pkcs7-region (point-min) (point-max))
+ (smime-pkcs7-certificates-region (point-min) (point-max)))
+ (with-temp-buffer
+ (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
+ (if (not (member mm-security-from
+ (and (smime-pkcs7-email-region
+ (point-min) (point-max))
+ (smime-buffer-as-string-region
+ (point-min) (point-max)))))
+ (progn
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Sender forged")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer
+ (mm-handle-multipart-original-buffer ctl)
+ (buffer-string))))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (kill-buffer smime-details-buffer))))
(mm-set-handle-multipart-parameter
mm-security-handle 'gnus-info "Failed")
(mm-set-handle-multipart-parameter
(buffer-substring
(point) (progn (end-of-line) (point))) force))
(progn
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-temp-buffer
+ (nnbabyl-request-article (car articles)
+ newsgroup server
+ (current-buffer))
+ (let ((nnml-current-directory nil))
+ (nnmail-expiry-target-group
+ nnmail-expiry-target newsgroup))))
(nnheader-message 5 "Deleting article %d in %s..."
(car articles) newsgroup)
(nnbabyl-delete-mail))
(when (nndraft-request-article article group server (current-buffer))
(message-remove-header "xref")
(message-remove-header "lines")
+ (message-remove-header "date")
t))
(deffoo nndraft-request-update-info (group info &optional server)
(require 'nnoo)
(eval-when-compile (require 'cl))
(require 'gnus-util)
+(require 'gnus-range)
(nnoo-declare nnfolder)
(buffer-substring
(point) (progn (end-of-line) (point)))
force nnfolder-inhibit-expiry))
- (nnheader-message 5 "Deleting article %d..."
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-temp-buffer
+ (nnfolder-request-article (car maybe-expirable)
+ newsgroup server (current-buffer))
+ (let ((nnml-current-directory nil))
+ (nnmail-expiry-target-group
+ nnmail-expiry-target newsgroup))))
+ (nnheader-message 5 "Deleting article %d in %s..."
(car maybe-expirable) newsgroup)
(nnfolder-delete-mail)
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(buffer-substring
(point) (progn (end-of-line) (point))) force))
(progn
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-temp-buffer
+ (nnmbox-request-article (car articles)
+ newsgroup server
+ (current-buffer))
+ (let ((nnml-current-directory nil))
+ (nnmail-expiry-target-group
+ nnmail-expiry-target newsgroup))))
(nnheader-message 5 "Deleting article %d in %s..."
(car articles) newsgroup)
(nnmbox-delete-mail))
(setq is-old
(nnmail-expired-article-p newsgroup mod-time force)))
(progn
+ ;; Allow a special target group. -- jcn
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-temp-buffer
+ (nnmh-request-article (car articles)
+ newsgroup server (current-buffer))
+ (nnmail-expiry-target-group
+ nnmail-expiry-target newsgroup)))
(nnheader-message 5 "Deleting article %s in %s..."
article newsgroup)
(condition-case ()
;; Especially, don't expect this library to buy security for you. If
;; you don't understand what you are doing, you're as likely to lose
;; security than gain any by using this library.
+;;
+;; This library is not intended to provide a "raw" API for S/MIME,
+;; PKCSx or similar, it's intended to perform common operations
+;; done on messages encoded in these formats. The terminology chosen
+;; reflect this.
;;; Quick introduction:
string)
:group 'dig)
-(defvar smime-details-buffer "*S/MIME OpenSSL output*")
+(defvar smime-details-buffer "*OpenSSL output*")
;; OpenSSL wrappers.
;; Verify+decrypt region
(defun smime-verify-region (b e)
- (let ((buffer (generate-new-buffer (generate-new-buffer-name "*smime*")))
+ (let ((buffer (get-buffer-create smime-details-buffer))
(CAs (cond (smime-CA-file
(list "-CAfile" (expand-file-name smime-CA-file)))
(smime-CA-directory
(list "-CApath" (expand-file-name smime-CA-directory)))
(t
(error "No CA configured.")))))
- (prog1
- (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" CAs)
- (message "S/MIME message verified succesfully.")
- (message "S/MIME message NOT verified successfully.")
- nil)
- (with-current-buffer (get-buffer-create smime-details-buffer)
- (goto-char (point-max))
- (insert-buffer buffer))
- (kill-buffer buffer))))
-
+ (with-current-buffer buffer
+ (erase-buffer))
+ (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" CAs)
+ (message "S/MIME message verified succesfully.")
+ (message "S/MIME message NOT verified successfully.")
+ nil)))
+
(defun smime-decrypt-region (b e keyfile)
(let ((buffer (generate-new-buffer (generate-new-buffer-name "*smime*")))
CAs)
(when (apply 'smime-call-openssl-region b e buffer "smime" "-decrypt"
- "-recip" keyfile)
+ "-recip" (list keyfile))
)
(with-current-buffer (get-buffer-create smime-details-buffer)
(with-current-buffer (or buffer (current-buffer))
(smime-decrypt-region
(point-min) (point-max)
- (or keyfile
- (smime-get-key-by-email
- (completing-read "Decrypt with which key? " smime-keys nil nil
- (and (listp (car-safe smime-keys))
- (caar smime-keys))))))))
+ (expand-file-name
+ (or keyfile
+ (smime-get-key-by-email
+ (completing-read "Decrypt with which key? " smime-keys nil nil
+ (and (listp (car-safe smime-keys))
+ (caar smime-keys)))))))))
+
+;; Various operations
+
+(defun smime-pkcs7-region (b e)
+ "Convert S/MIME message between points B and E into a PKCS7 message."
+ (let ((buffer (get-buffer-create smime-details-buffer)))
+ (with-current-buffer buffer
+ (erase-buffer))
+ (when (smime-call-openssl-region b e buffer "smime" "-pk7out")
+ (delete-region b e)
+ (insert-buffer-substring buffer)
+ t)))
+
+(defun smime-pkcs7-certificates-region (b e)
+ "Extract any certificates enclosed in PKCS7 message between points B and E."
+ (let ((buffer (get-buffer-create smime-details-buffer)))
+ (with-current-buffer buffer
+ (erase-buffer))
+ (when (smime-call-openssl-region b e buffer "pkcs7" "-print_certs" "-text")
+ (delete-region b e)
+ (insert-buffer-substring buffer)
+ t)))
+
+(defun smime-pkcs7-email-region (b e)
+ "Get email addresses contained in certificate between points B and E.
+A string or a list of strings is returned."
+ (let ((buffer (get-buffer-create smime-details-buffer)))
+ (with-current-buffer buffer
+ (erase-buffer))
+ (when (smime-call-openssl-region b e buffer "x509" "-email" "-noout")
+ (delete-region b e)
+ (insert-buffer-substring buffer)
+ t)))
+
+(defalias 'smime-point-at-eol
+ (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position))
+
+(defun smime-buffer-as-string-region (b e)
+ "Return each line in region between B and E as a list of strings."
+ (save-excursion
+ (goto-char b)
+ (let (res)
+ (while (< (point) e)
+ (push (buffer-substring (point) (smime-point-at-eol)) res)
+ (forward-line))
+ res)))
;; Find certificates
+2000-11-29 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.texi (Fancy Mail Splitting): Add.
+
2000-11-20 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus.texi (Archived Messages): Add.
When it has found a parent, it returns the corresponding group name. It
is recommended that you set @code{nnmail-message-id-cache-length} to a
somewhat higher number than the default so that the message ids are
-still in the cache. (A value of 5000 appears to create a file some
-300 kBytes in size.)
+still in the cache. (A value of 5000 appears to create a file some 300
+kBytes in size.) When @code{nnmail-cache-accepted-message-ids} is
+non-nil, Gnus also records the message ids of moved articles, so that
+the followup messages goes into the new group.
@node Group Mail Splitting
* Emphasis delimiters show when `W W c'.
+ [Fixed]
+
* Parsing of the common list confirmation requests so that Gnus can
prepare the response with a single command. Including LISTSERV
periodic ping messages and the like.
into [-] buttons. (If I click on one of the [+] buttons, it does
turn into a [-] button.)
+ [fixed]
+
* Perhaps there should be a command to "attach" a buffer of comments
to a message? That is, `B WHATEVER', you're popped into a buffer,
write something, end with `C-c C-c', and then the thing you've
projects / elisp / gnus.git- / commitdiff