*** pub/rgnus/lisp/gnus-msg.el Tue Mar 18 18:01:56 1997 --- rgnus/lisp/gnus-msg.el Wed Mar 19 21:00:20 1997 *************** *** 404,411 **** (message-mail (or to-address to-list)) ;; Arrange for mail groups that have no `to-address' to ;; get that when the user sends off the mail. ! (push (list 'gnus-inews-add-to-address pgroup) ! message-send-actions)) (set-buffer gnus-article-copy) (message-wide-reply to-address))) (when yank --- 404,413 ---- (message-mail (or to-address to-list)) ;; Arrange for mail groups that have no `to-address' to ;; get that when the user sends off the mail. ! (when (and (not to-list) ! (not to-address)) ! (push (list 'gnus-inews-add-to-address pgroup) ! message-send-actions))) (set-buffer gnus-article-copy) (message-wide-reply to-address))) (when yank *** pub/rgnus/lisp/gnus-start.el Fri Mar 14 20:17:18 1997 --- rgnus/lisp/gnus-start.el Wed Mar 19 21:00:21 1997 *************** *** 943,949 **** gnus-active-hashtb) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) - ;; Suggested by Per Abrahamsen . (if (> groups 0) (gnus-message 5 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has")) --- 943,948 ---- *** pub/rgnus/lisp/gnus-sum.el Wed Mar 19 00:04:14 1997 --- rgnus/lisp/gnus-sum.el Wed Mar 19 21:00:22 1997 *************** *** 288,293 **** --- 288,298 ---- :group 'gnus-article-headers :type 'boolean) + (defcustom gnus-summary-ignore-duplicates nil + "*If non-nil, ignore articles with identical Message-ID headers." + :group 'gnus-summary + :type 'boolean) + (defcustom gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." *************** *** 2465,2473 **** (let (result) (while (and group (null (setq result ! (gnus-summary-read-group-1 ! group show-all no-article ! kill-buffer no-display))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) (if (not (equal group (gnus-group-group-name))) --- 2470,2479 ---- (let (result) (while (and group (null (setq result ! (let ((gnus-auto-select-next nil)) ! (gnus-summary-read-group-1 ! group show-all no-article ! kill-buffer no-display)))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) (if (not (equal group (gnus-group-group-name))) *************** *** 4196,4204 **** (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) ! ;; An article with this Message-ID has already been seen, ! ;; so we rename the Message-ID. ! (progn (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) --- 4202,4221 ---- (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) ! ;; An article with this Message-ID has already been seen. ! (if gnus-summary-ignore-duplicates ! ;; We ignore this one, except we add ! ;; any additional Xrefs (in case the two articles ! ;; came from different servers). ! (progn ! (mail-header-set-xref ! (car (symbol-value id-dep)) ! (concat (or (mail-header-xref ! (car (symbol-value id-dep))) ! "") ! (or (mail-header-xref header) ""))) ! (setq header nil)) ! ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) *************** *** 4285,4293 **** (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) ! ;; An article with this Message-ID has already been seen, ! ;; so we rename the Message-ID. ! (progn (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) --- 4302,4321 ---- (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) ! ;; An article with this Message-ID has already been seen. ! (if gnus-summary-ignore-duplicates ! ;; We ignore this one, except we add any additional ! ;; Xrefs (in case the two articles came from different ! ;; servers. ! (progn ! (mail-header-set-xref ! (car (symbol-value id-dep)) ! (concat (or (mail-header-xref ! (car (symbol-value id-dep))) ! "") ! (or (mail-header-xref header) ""))) ! (setq header nil)) ! ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) *** pub/rgnus/lisp/gnus.el Wed Mar 19 00:04:14 1997 --- rgnus/lisp/gnus.el Wed Mar 19 21:00:22 1997 *************** *** 226,232 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.30" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) --- 226,232 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.31" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) *************** *** 2244,2251 **** (defun gnus-group-add-parameter (group param) "Add parameter PARAM to GROUP." (let ((info (gnus-get-info group))) ! (if (not info) ! () ; This is a dead group. We just ignore it. ;; Cons the new param to the old one and update. (gnus-group-set-info (cons param (gnus-info-params info)) group 'params)))) --- 2244,2251 ---- (defun gnus-group-add-parameter (group param) "Add parameter PARAM to GROUP." (let ((info (gnus-get-info group))) ! (when info ! (gnus-group-remove-parameter group (if (consp param) (car param) param)) ;; Cons the new param to the old one and update. (gnus-group-set-info (cons param (gnus-info-params info)) group 'params)))) *************** *** 2253,2260 **** (defun gnus-group-set-parameter (group name value) "Set parameter NAME to VALUE in GROUP." (let ((info (gnus-get-info group))) ! (if (not info) ! () ; This is a dead group. We just ignore it. (let ((old-params (gnus-info-params info)) (new-params (list (cons name value)))) (while old-params --- 2253,2260 ---- (defun gnus-group-set-parameter (group name value) "Set parameter NAME to VALUE in GROUP." (let ((info (gnus-get-info group))) ! (when info ! (gnus-group-remove-parameter group name) (let ((old-params (gnus-info-params info)) (new-params (list (cons name value)))) (while old-params *************** *** 2263,2268 **** --- 2263,2279 ---- (setq new-params (append new-params (list (car old-params))))) (setq old-params (cdr old-params))) (gnus-group-set-info new-params group 'params))))) + + (defun gnus-group-remove-parameter (group name) + "Remove parameter NAME from GROUP." + (let ((info (gnus-get-info group))) + (when info + (let ((params (gnus-info-params info))) + (when params + (setq params (delq name params)) + (while (assq name params) + (setq params (delq (assq name params) params))) + (gnus-info-set-params info params)))))) (defun gnus-group-add-score (group &optional score) "Add SCORE to the GROUP score. *** pub/rgnus/lisp/md5.el Fri Mar 7 23:51:27 1997 --- rgnus/lisp/md5.el Wed Mar 19 21:00:22 1997 *************** *** 1,411 **** ! ;;; md5.el -- MD5 Message Digest Algorithm ! ;;; Gareth Rees ! ! ;; LCD Archive Entry: ! ;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| ! ;; MD5 cryptographic message digest algorithm| ! ;; 13-Nov-95|1.0|~/misc/md5.el.Z| ! ! ;;; Details: ------------------------------------------------------------------ ! ! ;; This is a direct translation into Emacs LISP of the reference C ! ;; implementation of the MD5 Message-Digest Algorithm written by RSA ! ;; Data Security, Inc. ! ;; ! ;; The algorithm takes a message (that is, a string of bytes) and ! ;; computes a 16-byte checksum or "digest" for the message. This digest ! ;; is supposed to be cryptographically strong in the sense that if you ! ;; are given a 16-byte digest D, then there is no easier way to ! ;; construct a message whose digest is D than to exhaustively search the ! ;; space of messages. However, the robustness of the algorithm has not ! ;; been proven, and a similar algorithm (MD4) was shown to be unsound, ! ;; so treat with caution! ! ;; ! ;; The C algorithm uses 32-bit integers; because GNU Emacs ! ;; implementations provide 28-bit integers (with 24-bit integers on ! ;; versions prior to 19.29), the code represents a 32-bit integer as the ! ;; cons of two 16-bit integers. The most significant word is stored in ! ;; the car and the least significant in the cdr. The algorithm requires ! ;; at least 17 bits of integer representation in order to represent the ! ;; carry from a 16-bit addition. ! ! ;;; Usage: -------------------------------------------------------------------- ! ! ;; To compute the MD5 Message Digest for a message M (represented as a ! ;; string or as a vector of bytes), call ! ;; ! ;; (md5-encode M) ! ;; ! ;; which returns the message digest as a vector of 16 bytes. If you ! ;; need to supply the message in pieces M1, M2, ... Mn, then call ! ;; ! ;; (md5-init) ! ;; (md5-update M1) ! ;; (md5-update M2) ! ;; ... ! ;; (md5-update Mn) ! ;; (md5-final) ! ! ;;; Copyright and licence: ---------------------------------------------------- ! ! ;; Copyright (C) 1995 by Gareth Rees ! ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm ! ;; ! ;; md5.el 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. ! ;; ! ;; md5.el 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. ! ;; ! ;; The original copyright notice is given below, as required by the ! ;; licence for the original code. This code is distributed under *both* ! ;; RSA's original licence and the GNU General Public Licence. (There ! ;; should be no problems, as the former is more liberal than the ! ;; latter). ! ! ;;; Original copyright notice: ------------------------------------------------ ! ! ;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ! ;; ! ;; License to copy and use this software is granted provided that it is ! ;; identified as the "RSA Data Security, Inc. MD5 Message- Digest ! ;; Algorithm" in all material mentioning or referencing this software or ! ;; this function. ! ;; ! ;; License is also granted to make and use derivative works provided ! ;; that such works are identified as "derived from the RSA Data ! ;; Security, Inc. MD5 Message-Digest Algorithm" in all material ! ;; mentioning or referencing the derived work. ! ;; ! ;; RSA Data Security, Inc. makes no representations concerning either ! ;; the merchantability of this software or the suitability of this ! ;; software for any particular purpose. It is provided "as is" without ! ;; express or implied warranty of any kind. ! ;; ! ;; These notices must be retained in any copies of any part of this ! ;; documentation and/or software. ! ! ;;; Code: --------------------------------------------------------------------- ! ! (defvar md5-program "md5" ! "*Program that reads a message on its standard input and writes an ! MD5 digest on its output.") ! ! (defvar md5-maximum-internal-length 4096 ! "*The maximum size of a piece of data that should use the MD5 routines ! written in lisp. If a message exceeds this, it will be run through an ! external filter for processing. Also see the `md5-program' variable. ! This variable has no effect if you call the md5-init|update|final ! functions - only used by the `md5' function's simpler interface.") ! ! (defvar md5-bits (make-vector 4 0) ! "Number of bits handled, modulo 2^64. ! Represented as four 16-bit numbers, least significant first.") ! (defvar md5-buffer (make-vector 4 '(0 . 0)) ! "Scratch buffer (four 32-bit integers).") ! (defvar md5-input (make-vector 64 0) ! "Input buffer (64 bytes).") ! ! (defun md5-unhex (x) ! (if (> x ?9) ! (if (>= x ?a) ! (+ 10 (- x ?a)) ! (+ 10 (- x ?A))) ! (- x ?0))) ! ! (defun md5-encode (message) ! "Encodes MESSAGE using the MD5 message digest algorithm. ! MESSAGE must be a string or an array of bytes. ! Returns a vector of 16 bytes containing the message digest." ! (if (<= (length message) md5-maximum-internal-length) ! (progn ! (md5-init) ! (md5-update message) ! (md5-final)) ! (save-excursion ! (set-buffer (get-buffer-create " *md5-work*")) ! (erase-buffer) ! (insert message) ! (call-process-region (point-min) (point-max) ! (or shell-file-name "/bin/sh") ! t (current-buffer) nil ! "-c" md5-program) ! ;; MD5 digest is 32 chars long ! ;; mddriver adds a newline to make neaten output for tty ! ;; viewing, make sure we leave it behind. ! (let ((data (buffer-substring (point-min) (+ (point-min) 32))) ! (vec (make-vector 16 0)) ! (ctr 0)) ! (while (< ctr 16) ! (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) ! (md5-unhex (aref data (1+ (* ctr 2)))))) ! (setq ctr (1+ ctr))))))) ! ! (defsubst md5-add (x y) ! "Return 32-bit sum of 32-bit integers X and Y." ! (let ((m (+ (car x) (car y))) ! (l (+ (cdr x) (cdr y)))) ! (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) ! ! ;; FF, GG, HH and II are basic MD5 functions, providing transformations ! ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this ! ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x ! ;; by y bits to the left): ! ;; ! ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b ! ;; ! ;; so we use the macro `md5-make-step' to construct each one. The ! ;; helper functions F, G, H and I operate on 16-bit numbers; the full ! ;; operation splits its inputs, operates on the halves separately and ! ;; then puts the results together. ! ! (defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) ! (defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) ! (defsubst md5-H (x y z) (logxor x y z)) ! (defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) ! ! (defmacro md5-make-step (name func) ! (` ! (defun (, name) (a b c d x s ac) ! (let* ! ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) ! (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) ! (m2 (logand 65535 (+ m1 (lsh l1 -16)))) ! (l2 (logand 65535 l1)) ! (m3 (logand 65535 (if (> s 15) ! (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) ! (+ (lsh m2 s) (lsh l2 (- s 16)))))) ! (l3 (logand 65535 (if (> s 15) ! (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) ! (+ (lsh l2 s) (lsh m2 (- s 16))))))) ! (md5-add (cons m3 l3) b))))) ! ! (md5-make-step md5-FF md5-F) ! (md5-make-step md5-GG md5-G) ! (md5-make-step md5-HH md5-H) ! (md5-make-step md5-II md5-I) ! ! (defun md5-init () ! "Initialize the state of the message-digest routines." ! (aset md5-bits 0 0) ! (aset md5-bits 1 0) ! (aset md5-bits 2 0) ! (aset md5-bits 3 0) ! (aset md5-buffer 0 '(26437 . 8961)) ! (aset md5-buffer 1 '(61389 . 43913)) ! (aset md5-buffer 2 '(39098 . 56574)) ! (aset md5-buffer 3 '( 4146 . 21622))) ! ! (defun md5-update (string) ! "Update the current MD5 state with STRING (an array of bytes)." ! (let ((len (length string)) ! (i 0) ! (j 0)) ! (while (< i len) ! ;; Compute number of bytes modulo 64 ! (setq j (% (/ (aref md5-bits 0) 8) 64)) ! ! ;; Store this byte (truncating to 8 bits to be sure) ! (aset md5-input j (logand 255 (aref string i))) ! ! ;; Update number of bits by 8 (modulo 2^64) ! (let ((c 8) (k 0)) ! (while (and (> c 0) (< k 4)) ! (let ((b (aref md5-bits k))) ! (aset md5-bits k (logand 65535 (+ b c))) ! (setq c (if (> b (- 65535 c)) 1 0) ! k (1+ k))))) ! ! ;; Increment number of bytes processed ! (setq i (1+ i)) ! ! ;; When 64 bytes accumulated, pack them into sixteen 32-bit ! ;; integers in the array `in' and then tranform them. ! (if (= j 63) ! (let ((in (make-vector 16 (cons 0 0))) ! (k 0) ! (kk 0)) ! (while (< k 16) ! (aset in k (md5-pack md5-input kk)) ! (setq k (+ k 1) kk (+ kk 4))) ! (md5-transform in)))))) ! ! (defun md5-pack (array i) ! "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." ! (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) ! (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) ! ! (defun md5-byte (array n b) ! "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." ! (let ((e (aref array n))) ! (cond ((eq b 0) (logand 255 (cdr e))) ! ((eq b 1) (lsh (cdr e) -8)) ! ((eq b 2) (logand 255 (car e))) ! ((eq b 3) (lsh (car e) -8))))) ! ! (defun md5-final () ! (let ((in (make-vector 16 (cons 0 0))) ! (j 0) ! (digest (make-vector 16 0)) ! (padding)) ! ! ;; Save the number of bits in the message ! (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) ! (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) ! ! ;; Compute number of bytes modulo 64 ! (setq j (% (/ (aref md5-bits 0) 8) 64)) ! ! ;; Pad out computation to 56 bytes modulo 64 ! (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) ! (aset padding 0 128) ! (md5-update padding) ! ! ;; Append length in bits and transform ! (let ((k 0) (kk 0)) ! (while (< k 14) ! (aset in k (md5-pack md5-input kk)) ! (setq k (+ k 1) kk (+ kk 4)))) ! (md5-transform in) ! ! ;; Store the results in the digest ! (let ((k 0) (kk 0)) ! (while (< k 4) ! (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) ! (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) ! (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) ! (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) ! (setq k (+ k 1) kk (+ kk 4)))) ! ! ;; Return digest ! digest)) ! ! ;; It says in the RSA source, "Note that if the Mysterious Constants are ! ;; arranged backwards in little-endian order and decrypted with the DES ! ;; they produce OCCULT MESSAGES!" Security through obscurity? ! ! (defun md5-transform (in) ! "Basic MD5 step. Transform md5-buffer based on array IN." ! (let ((a (aref md5-buffer 0)) ! (b (aref md5-buffer 1)) ! (c (aref md5-buffer 2)) ! (d (aref md5-buffer 3))) ! (setq ! a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) ! d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) ! c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) ! b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) ! a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) ! d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) ! c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) ! b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) ! a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) ! d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) ! c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) ! b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) ! a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) ! d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) ! c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) ! b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) ! a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) ! d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) ! c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) ! b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) ! a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) ! d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) ! c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) ! b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) ! a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) ! d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) ! c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) ! b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) ! a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) ! d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) ! c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) ! b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) ! a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) ! d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) ! c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) ! b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) ! a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) ! d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) ! c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) ! b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) ! a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) ! d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) ! c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) ! b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) ! a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) ! d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) ! c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) ! b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) ! a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) ! d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) ! c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) ! b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) ! a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) ! d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) ! c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) ! b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) ! a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) ! d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) ! c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) ! b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) ! a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) ! d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) ! c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) ! b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) ! ! (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) ! (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) ! (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) ! (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) ! ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! ;;; Here begins the merger with the XEmacs API and the md5.el from the URL ! ;;; package. Courtesy wmperry@spry.com ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! (eval-and-compile ! (unless (fboundp 'md5) ! (defun md5 (object &optional start end) ! "Return the MD5 (a secure message digest algorithm) of an object. ! OBJECT is either a string or a buffer. ! Optional arguments START and END denote buffer positions for computing the ! hash of a portion of OBJECT." ! (let ((buffer nil)) ! (unwind-protect ! (save-excursion ! (setq buffer (generate-new-buffer " *md5-work*")) ! (set-buffer buffer) ! (cond ! ((bufferp object) ! (insert-buffer-substring object start end)) ! ((stringp object) ! (insert (if (or start end) ! (substring object start end) ! object))) ! (t nil)) ! (prog1 ! (if (<= (point-max) md5-maximum-internal-length) ! (mapconcat ! (function (lambda (node) (format "%02x" node))) ! (md5-encode (buffer-string)) ! "") ! (call-process-region (point-min) (point-max) ! (or shell-file-name "/bin/sh") ! t buffer nil ! "-c" md5-program) ! ;; MD5 digest is 32 chars long ! ;; mddriver adds a newline to make neaten output for tty ! ;; viewing, make sure we leave it behind. ! (buffer-substring (point-min) (+ (point-min) 32))) ! (kill-buffer buffer))) ! (and buffer (kill-buffer buffer) nil)))))) ! ! (provide 'md5) ! ! ;;; md5.el ends here ---------------------------------------------------------- --- 1,409 ---- ! ;;; md5.el -- MD5 Message Digest Algorithm ! ;;; Gareth Rees ! ! ;; LCD Archive Entry: ! ;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| ! ;; MD5 cryptographic message digest algorithm| ! ;; 13-Nov-95|1.0|~/misc/md5.el.Z| ! ! ;;; Details: ------------------------------------------------------------------ ! ! ;; This is a direct translation into Emacs LISP of the reference C ! ;; implementation of the MD5 Message-Digest Algorithm written by RSA ! ;; Data Security, Inc. ! ;; ! ;; The algorithm takes a message (that is, a string of bytes) and ! ;; computes a 16-byte checksum or "digest" for the message. This digest ! ;; is supposed to be cryptographically strong in the sense that if you ! ;; are given a 16-byte digest D, then there is no easier way to ! ;; construct a message whose digest is D than to exhaustively search the ! ;; space of messages. However, the robustness of the algorithm has not ! ;; been proven, and a similar algorithm (MD4) was shown to be unsound, ! ;; so treat with caution! ! ;; ! ;; The C algorithm uses 32-bit integers; because GNU Emacs ! ;; implementations provide 28-bit integers (with 24-bit integers on ! ;; versions prior to 19.29), the code represents a 32-bit integer as the ! ;; cons of two 16-bit integers. The most significant word is stored in ! ;; the car and the least significant in the cdr. The algorithm requires ! ;; at least 17 bits of integer representation in order to represent the ! ;; carry from a 16-bit addition. ! ! ;;; Usage: -------------------------------------------------------------------- ! ! ;; To compute the MD5 Message Digest for a message M (represented as a ! ;; string or as a vector of bytes), call ! ;; ! ;; (md5-encode M) ! ;; ! ;; which returns the message digest as a vector of 16 bytes. If you ! ;; need to supply the message in pieces M1, M2, ... Mn, then call ! ;; ! ;; (md5-init) ! ;; (md5-update M1) ! ;; (md5-update M2) ! ;; ... ! ;; (md5-update Mn) ! ;; (md5-final) ! ! ;;; Copyright and licence: ---------------------------------------------------- ! ! ;; Copyright (C) 1995 by Gareth Rees ! ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm ! ;; ! ;; md5.el 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. ! ;; ! ;; md5.el 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. ! ;; ! ;; The original copyright notice is given below, as required by the ! ;; licence for the original code. This code is distributed under *both* ! ;; RSA's original licence and the GNU General Public Licence. (There ! ;; should be no problems, as the former is more liberal than the ! ;; latter). ! ! ;;; Original copyright notice: ------------------------------------------------ ! ! ;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ! ;; ! ;; License to copy and use this software is granted provided that it is ! ;; identified as the "RSA Data Security, Inc. MD5 Message- Digest ! ;; Algorithm" in all material mentioning or referencing this software or ! ;; this function. ! ;; ! ;; License is also granted to make and use derivative works provided ! ;; that such works are identified as "derived from the RSA Data ! ;; Security, Inc. MD5 Message-Digest Algorithm" in all material ! ;; mentioning or referencing the derived work. ! ;; ! ;; RSA Data Security, Inc. makes no representations concerning either ! ;; the merchantability of this software or the suitability of this ! ;; software for any particular purpose. It is provided "as is" without ! ;; express or implied warranty of any kind. ! ;; ! ;; These notices must be retained in any copies of any part of this ! ;; documentation and/or software. ! ! ;;; Code: --------------------------------------------------------------------- ! ! (defvar md5-program "md5" ! "*Program that reads a message on its standard input and writes an ! MD5 digest on its output.") ! ! (defvar md5-maximum-internal-length 4096 ! "*The maximum size of a piece of data that should use the MD5 routines ! written in lisp. If a message exceeds this, it will be run through an ! external filter for processing. Also see the `md5-program' variable. ! This variable has no effect if you call the md5-init|update|final ! functions - only used by the `md5' function's simpler interface.") ! ! (defvar md5-bits (make-vector 4 0) ! "Number of bits handled, modulo 2^64. ! Represented as four 16-bit numbers, least significant first.") ! (defvar md5-buffer (make-vector 4 '(0 . 0)) ! "Scratch buffer (four 32-bit integers).") ! (defvar md5-input (make-vector 64 0) ! "Input buffer (64 bytes).") ! ! (defun md5-unhex (x) ! (if (> x ?9) ! (if (>= x ?a) ! (+ 10 (- x ?a)) ! (+ 10 (- x ?A))) ! (- x ?0))) ! ! (defun md5-encode (message) ! "Encodes MESSAGE using the MD5 message digest algorithm. ! MESSAGE must be a string or an array of bytes. ! Returns a vector of 16 bytes containing the message digest." ! (if (<= (length message) md5-maximum-internal-length) ! (progn ! (md5-init) ! (md5-update message) ! (md5-final)) ! (save-excursion ! (set-buffer (get-buffer-create " *md5-work*")) ! (erase-buffer) ! (insert message) ! (call-process-region (point-min) (point-max) ! (or shell-file-name "/bin/sh") ! t (current-buffer) nil ! "-c" md5-program) ! ;; MD5 digest is 32 chars long ! ;; mddriver adds a newline to make neaten output for tty ! ;; viewing, make sure we leave it behind. ! (let ((data (buffer-substring (point-min) (+ (point-min) 32))) ! (vec (make-vector 16 0)) ! (ctr 0)) ! (while (< ctr 16) ! (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) ! (md5-unhex (aref data (1+ (* ctr 2)))))) ! (setq ctr (1+ ctr))))))) ! ! (defsubst md5-add (x y) ! "Return 32-bit sum of 32-bit integers X and Y." ! (let ((m (+ (car x) (car y))) ! (l (+ (cdr x) (cdr y)))) ! (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) ! ! ;; FF, GG, HH and II are basic MD5 functions, providing transformations ! ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this ! ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x ! ;; by y bits to the left): ! ;; ! ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b ! ;; ! ;; so we use the macro `md5-make-step' to construct each one. The ! ;; helper functions F, G, H and I operate on 16-bit numbers; the full ! ;; operation splits its inputs, operates on the halves separately and ! ;; then puts the results together. ! ! (defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) ! (defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) ! (defsubst md5-H (x y z) (logxor x y z)) ! (defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) ! ! (defmacro md5-make-step (name func) ! (` ! (defun (, name) (a b c d x s ac) ! (let* ! ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) ! (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) ! (m2 (logand 65535 (+ m1 (lsh l1 -16)))) ! (l2 (logand 65535 l1)) ! (m3 (logand 65535 (if (> s 15) ! (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) ! (+ (lsh m2 s) (lsh l2 (- s 16)))))) ! (l3 (logand 65535 (if (> s 15) ! (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) ! (+ (lsh l2 s) (lsh m2 (- s 16))))))) ! (md5-add (cons m3 l3) b))))) ! ! (md5-make-step md5-FF md5-F) ! (md5-make-step md5-GG md5-G) ! (md5-make-step md5-HH md5-H) ! (md5-make-step md5-II md5-I) ! ! (defun md5-init () ! "Initialise the state of the message-digest routines." ! (aset md5-bits 0 0) ! (aset md5-bits 1 0) ! (aset md5-bits 2 0) ! (aset md5-bits 3 0) ! (aset md5-buffer 0 '(26437 . 8961)) ! (aset md5-buffer 1 '(61389 . 43913)) ! (aset md5-buffer 2 '(39098 . 56574)) ! (aset md5-buffer 3 '( 4146 . 21622))) ! ! (defun md5-update (string) ! "Update the current MD5 state with STRING (an array of bytes)." ! (let ((len (length string)) ! (i 0) ! (j 0)) ! (while (< i len) ! ;; Compute number of bytes modulo 64 ! (setq j (% (/ (aref md5-bits 0) 8) 64)) ! ! ;; Store this byte (truncating to 8 bits to be sure) ! (aset md5-input j (logand 255 (aref string i))) ! ! ;; Update number of bits by 8 (modulo 2^64) ! (let ((c 8) (k 0)) ! (while (and (> c 0) (< k 4)) ! (let ((b (aref md5-bits k))) ! (aset md5-bits k (logand 65535 (+ b c))) ! (setq c (if (> b (- 65535 c)) 1 0) ! k (1+ k))))) ! ! ;; Increment number of bytes processed ! (setq i (1+ i)) ! ! ;; When 64 bytes accumulated, pack them into sixteen 32-bit ! ;; integers in the array `in' and then tranform them. ! (if (= j 63) ! (let ((in (make-vector 16 (cons 0 0))) ! (k 0) ! (kk 0)) ! (while (< k 16) ! (aset in k (md5-pack md5-input kk)) ! (setq k (+ k 1) kk (+ kk 4))) ! (md5-transform in)))))) ! ! (defun md5-pack (array i) ! "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." ! (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) ! (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) ! ! (defun md5-byte (array n b) ! "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." ! (let ((e (aref array n))) ! (cond ((eq b 0) (logand 255 (cdr e))) ! ((eq b 1) (lsh (cdr e) -8)) ! ((eq b 2) (logand 255 (car e))) ! ((eq b 3) (lsh (car e) -8))))) ! ! (defun md5-final () ! (let ((in (make-vector 16 (cons 0 0))) ! (j 0) ! (digest (make-vector 16 0)) ! (padding)) ! ! ;; Save the number of bits in the message ! (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) ! (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) ! ! ;; Compute number of bytes modulo 64 ! (setq j (% (/ (aref md5-bits 0) 8) 64)) ! ! ;; Pad out computation to 56 bytes modulo 64 ! (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) ! (aset padding 0 128) ! (md5-update padding) ! ! ;; Append length in bits and transform ! (let ((k 0) (kk 0)) ! (while (< k 14) ! (aset in k (md5-pack md5-input kk)) ! (setq k (+ k 1) kk (+ kk 4)))) ! (md5-transform in) ! ! ;; Store the results in the digest ! (let ((k 0) (kk 0)) ! (while (< k 4) ! (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) ! (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) ! (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) ! (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) ! (setq k (+ k 1) kk (+ kk 4)))) ! ! ;; Return digest ! digest)) ! ! ;; It says in the RSA source, "Note that if the Mysterious Constants are ! ;; arranged backwards in little-endian order and decrypted with the DES ! ;; they produce OCCULT MESSAGES!" Security through obscurity? ! ! (defun md5-transform (in) ! "Basic MD5 step. Transform md5-buffer based on array IN." ! (let ((a (aref md5-buffer 0)) ! (b (aref md5-buffer 1)) ! (c (aref md5-buffer 2)) ! (d (aref md5-buffer 3))) ! (setq ! a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) ! d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) ! c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) ! b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) ! a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) ! d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) ! c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) ! b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) ! a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) ! d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) ! c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) ! b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) ! a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) ! d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) ! c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) ! b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) ! a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) ! d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) ! c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) ! b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) ! a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) ! d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) ! c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) ! b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) ! a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) ! d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) ! c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) ! b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) ! a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) ! d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) ! c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) ! b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) ! a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) ! d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) ! c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) ! b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) ! a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) ! d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) ! c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) ! b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) ! a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) ! d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) ! c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) ! b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) ! a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) ! d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) ! c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) ! b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) ! a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) ! d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) ! c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) ! b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) ! a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) ! d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) ! c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) ! b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) ! a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) ! d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) ! c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) ! b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) ! a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) ! d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) ! c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) ! b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) ! ! (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) ! (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) ! (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) ! (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) ! ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! ;;; Here begins the merger with the XEmacs API and the md5.el from the URL ! ;;; package. Courtesy wmperry@spry.com ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! (defun md5 (object &optional start end) ! "Return the MD5 (a secure message digest algorithm) of an object. ! OBJECT is either a string or a buffer. ! Optional arguments START and END denote buffer positions for computing the ! hash of a portion of OBJECT." ! (let ((buffer nil)) ! (unwind-protect ! (save-excursion ! (setq buffer (generate-new-buffer " *md5-work*")) ! (set-buffer buffer) ! (cond ! ((bufferp object) ! (insert-buffer-substring object start end)) ! ((stringp object) ! (insert (if (or start end) ! (substring object start end) ! object))) ! (t nil)) ! (prog1 ! (if (<= (point-max) md5-maximum-internal-length) ! (mapconcat ! (function (lambda (node) (format "%02x" node))) ! (md5-encode (buffer-string)) ! "") ! (call-process-region (point-min) (point-max) ! (or shell-file-name "/bin/sh") ! t buffer nil ! "-c" md5-program) ! ;; MD5 digest is 32 chars long ! ;; mddriver adds a newline to make neaten output for tty ! ;; viewing, make sure we leave it behind. ! (buffer-substring (point-min) (+ (point-min) 32))) ! (kill-buffer buffer))) ! (and buffer (kill-buffer buffer) nil)))) ! ! (provide 'md5) ! ! ;;; md5.el ends here ---------------------------------------------------------- *** pub/rgnus/lisp/message.el Mon Mar 17 17:40:27 1997 --- rgnus/lisp/message.el Wed Mar 19 21:00:23 1997 *************** *** 3007,3012 **** --- 3007,3015 ---- (insert (if (bolp) "" ", ") (or to "")) (insert (if mct (concat (if (bolp) "" ", ") mct) "")) (insert (if cc (concat (if (bolp) "" ", ") cc) "")) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+" nil t) + (replace-match " " t t)) ;; Remove addresses that match `rmail-dont-reply-to-names'. (insert (prog1 (rmail-dont-reply-to (buffer-string)) (erase-buffer))) *** pub/rgnus/lisp/nnbabyl.el Tue Mar 18 18:01:58 1997 --- rgnus/lisp/nnbabyl.el Wed Mar 19 21:00:23 1997 *************** *** 333,338 **** --- 333,340 ---- (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnbabyl-save-mail (if (stringp group) (list (cons group (nnbabyl-active-number group))) *************** *** 343,348 **** --- 345,352 ---- (goto-char (match-end 0)) (insert-buffer-substring buf) (when last + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) *** pub/rgnus/lisp/nnfolder.el Tue Mar 18 18:01:59 1997 --- rgnus/lisp/nnfolder.el Wed Mar 19 21:00:24 1997 *************** *** 375,380 **** --- 375,382 ---- (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnfolder-save-mail (if (stringp group) *************** *** 384,390 **** (when last (save-excursion (nnfolder-possibly-change-folder (or (caar art-group) group)) ! (nnfolder-save-buffer)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) --- 386,394 ---- (when last (save-excursion (nnfolder-possibly-change-folder (or (caar art-group) group)) ! (nnfolder-save-buffer) ! (when nnmail-cache-accepted-message-ids ! (nnmail-cache-close))))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) *************** *** 643,649 **** (let ((delim (concat "^" message-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") ! (active (cadr (assoc group nnfolder-group-alist))) (scantime (assoc group nnfolder-scantime-alist)) (minid (lsh -1 -1)) maxid start end newscantime --- 647,654 ---- (let ((delim (concat "^" message-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") ! (active (or (cadr (assoc group nnfolder-group-alist)) ! (cons 1 0))) (scantime (assoc group nnfolder-scantime-alist)) (minid (lsh -1 -1)) maxid start end newscantime *** pub/rgnus/lisp/nnmail.el Mon Mar 17 17:40:28 1997 --- rgnus/lisp/nnmail.el Wed Mar 19 21:00:24 1997 *************** *** 160,165 **** --- 160,170 ---- :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) + (defcustom nnmail-cache-accepted-message-ids nil + "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." + :group nnmail + :type boolean) + (defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) *************** *** 853,860 **** ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) ! (forward-line 1) ! (point)))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) --- 858,865 ---- ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) ! (forward-line 1)) ! (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) *************** *** 937,944 **** ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) ! (forward-line 1) ! (point)))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) --- 942,949 ---- ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) ! (forward-line 1)) ! (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) *** pub/rgnus/lisp/nnmbox.el Tue Mar 18 18:01:59 1997 --- rgnus/lisp/nnmbox.el Wed Mar 19 21:00:24 1997 *************** *** 304,309 **** --- 304,311 ---- (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) *************** *** 313,318 **** --- 315,322 ---- (goto-char (point-max)) (insert-buffer-substring buf) (when last + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) (nnmail-save-active nnmbox-group-alist nnmbox-active-file) (save-buffer)))) (car result))) *** pub/rgnus/lisp/nnmh.el Tue Mar 18 18:02:00 1997 --- rgnus/lisp/nnmh.el Wed Mar 19 21:00:25 1997 *************** *** 290,305 **** (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) ! (if (stringp group) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail ! (list (cons group (nnmh-active-number group))) ! noinsert))) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) ! noinsert))))) (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) --- 290,310 ---- (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) ! (when nnmail-cache-accepted-message-ids ! (nnmail-cache-insert (nnmail-fetch-field "message-id"))) ! (prog1 ! (if (stringp group) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail ! (list (cons group (nnmh-active-number group))) ! noinsert))) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) ! noinsert)))) ! (when (and last nnmail-cache-accepted-message-ids) ! (nnmail-cache-close)))) (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) *** pub/rgnus/lisp/nnml.el Tue Mar 18 18:02:00 1997 --- rgnus/lisp/nnml.el Wed Mar 19 21:00:25 1997 *************** *** 313,318 **** --- 313,320 ---- (nnml-possibly-change-directory group server) (nnmail-check-syntax) (let (result) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (if (stringp group) (and (nnmail-activate 'nnml) *************** *** 327,332 **** --- 329,336 ---- (nnmail-article-group 'nnml-active-number)))) (when last (nnmail-save-active nnml-group-alist nnml-active-file) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) (nnml-save-nov)))) result)) *** pub/rgnus/lisp/pop3.el Sun Jan 5 09:49:42 1997 --- rgnus/lisp/pop3.el Wed Mar 19 21:00:25 1997 *************** *** 1,430 **** ! ;;; pop3.el --- Post Office Protocol (RFC 1460) interface ! ! ;; Copyright (C) 1996, Free Software Foundation, Inc. ! ! ;; Author: Richard L. Pieri ! ;; Keywords: mail, pop3 ! ;; Version: 1.3 ! ! ;; This file is 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: ! ! ;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands ! ;; are implemented. The LIST command has not been implemented due to lack ! ;; of actual usefulness. ! ;; The optional POP3 command TOP has not been implemented. ! ! ;; This program was inspired by Kyle E. Jones's vm-pop program. ! ! ;;; Code: ! ! (require 'mail-utils) ! (provide 'pop3) ! ! (eval-and-compile ! (if (not (fboundp 'md5)) (autoload 'md5 "md5"))) ! ! (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) ! "*POP3 maildrop.") ! (defvar pop3-mailhost (or (getenv "MAILHOST") nil) ! "*POP3 mailhost.") ! (defvar pop3-port 110 ! "*POP3 port.") ! ! (defvar pop3-password-required t ! "*Non-nil if a password is required when connecting to POP server.") ! (defvar pop3-password nil ! "*Password to use when connecting to POP server.") ! ! (defvar pop3-authentication-scheme 'pass ! "*POP3 authentication scheme. Defaults to 'pass, for the standard ! USER/PASS authentication. Other valid values are 'apop.") ! ! (defvar pop3-timestamp nil ! "Timestamp returned when initially connected to the POP server. ! Used for APOP authentication.") ! ! (defvar pop3-read-point nil) ! (defvar pop3-debug nil) ! ! (defun pop3-movemail (&optional crashbox) ! "Transfer contents of a maildrop to the specified CRASHBOX." ! (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) ! (let* ((process (pop3-open-server pop3-mailhost pop3-port)) ! (crashbuf (get-buffer-create " *pop3-retr*")) ! (n 1) ! message-count) ! ;; for debugging only ! (if pop3-debug (switch-to-buffer (process-buffer process))) ! (cond ((equal 'apop pop3-authentication-scheme) ! (pop3-apop process pop3-maildrop)) ! ((equal 'pass pop3-authentication-scheme) ! (pop3-user process pop3-maildrop) ! (pop3-pass process)) ! (t (error "Invalid POP3 authentication scheme."))) ! (setq message-count (car (pop3-stat process))) ! (while (<= n message-count) ! (message (format "Retrieving message %d of %d from %s..." ! n message-count pop3-mailhost)) ! (pop3-retr process n crashbuf) ! (save-excursion ! (set-buffer crashbuf) ! (append-to-file (point-min) (point-max) crashbox)) ! (pop3-dele process n) ! (setq n (+ 1 n))) ! (pop3-quit process) ! (kill-buffer crashbuf) ! ) ! ) ! ! (defun pop3-open-server (mailhost port) ! "Open TCP connection to MAILHOST. ! Returns the process associated with the connection." ! (let ((process-buffer ! (get-buffer-create (format "trace of POP session to %s" mailhost))) ! (process)) ! (save-excursion ! (set-buffer process-buffer) ! (erase-buffer)) ! (setq process ! (open-network-stream "POP" process-buffer mailhost port)) ! (setq pop3-read-point (point-min)) ! (let ((response (pop3-read-response process t))) ! (setq pop3-timestamp ! (substring response (or (string-match "<" response) 0) ! (+ 1 (or (string-match ">" response) -1))))) ! process ! )) ! ! ;; Support functions ! ! (defun pop3-process-filter (process output) ! (save-excursion ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! (insert output))) ! ! (defun pop3-send-command (process command) ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! ;; (if (= (aref command 0) ?P) ! ;; (insert "PASS \r\n") ! ;; (insert command "\r\n")) ! (setq pop3-read-point (point)) ! (goto-char (point-max)) ! (process-send-string process command) ! (process-send-string process "\r\n") ! ) ! ! (defun pop3-read-response (process &optional return) ! "Read the response from the server. ! Return the response string if optional second argument is non-nil." ! (let ((case-fold-search nil) ! match-end) ! (save-excursion ! (set-buffer (process-buffer process)) ! (goto-char pop3-read-point) ! (while (not (search-forward "\r\n" nil t)) ! (accept-process-output process) ! (goto-char pop3-read-point)) ! (setq match-end (point)) ! (goto-char pop3-read-point) ! (if (looking-at "-ERR") ! (error (buffer-substring (point) (- match-end 2))) ! (if (not (looking-at "+OK")) ! (progn (setq pop3-read-point match-end) nil) ! (setq pop3-read-point match-end) ! (if return ! (buffer-substring (point) match-end) ! t) ! ))))) ! ! (defun pop3-string-to-list (string &optional regexp) ! "Chop up a string into a list." ! (let ((list) ! (regexp (or regexp " ")) ! (string (if (string-match "\r" string) ! (substring string 0 (match-beginning 0)) ! string))) ! (store-match-data nil) ! (while string ! (if (string-match regexp string) ! (setq list (cons (substring string 0 (- (match-end 0) 1)) list) ! string (substring string (match-end 0))) ! (setq list (cons string list) ! string nil))) ! (nreverse list))) ! ! (defvar pop3-read-passwd nil) ! (defun pop3-read-passwd (prompt) ! (if (not pop3-read-passwd) ! (if (load "passwd" t) ! (setq pop3-read-passwd 'read-passwd) ! (autoload 'ange-ftp-read-passwd "ange-ftp") ! (setq pop3-read-passwd 'ange-ftp-read-passwd))) ! (funcall pop3-read-passwd prompt)) ! ! (defun pop3-clean-region (start end) ! (setq end (set-marker (make-marker) end)) ! (save-excursion ! (goto-char start) ! (while (and (< (point) end) (search-forward "\r\n" end t)) ! (replace-match "\n" t t)) ! (goto-char start) ! (while (and (< (point) end) (re-search-forward "^\\." end t)) ! (replace-match "" t t) ! (forward-char))) ! (set-marker end nil)) ! ! (defun pop3-munge-message-separator (start end) ! "Check to see if a message separator exists. If not, generate one." ! (save-excursion ! (save-restriction ! (narrow-to-region start end) ! (goto-char (point-min)) ! (if (not (or (looking-at "From .?") ; Unix mail ! (looking-at "\001\001\001\001\n") ; MMDF ! (looking-at "BABYL OPTIONS:") ; Babyl ! )) ! (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) ! (date (pop3-string-to-list (mail-fetch-field "Date"))) ! (From_)) ! ;; sample date formats I have seen ! ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) ! ;; Date: 08 Jul 1996 23:22:24 -0400 ! ;; should be ! ;; Tue Jul 9 09:04:21 1996 ! (setq date ! (cond ((string-match "[A-Z]" (nth 0 date)) ! (format "%s %s %s %s %s" ! (nth 0 date) (nth 2 date) (nth 1 date) ! (nth 4 date) (nth 3 date))) ! (t ! ;; this really needs to be better but I don't feel ! ;; like writing a date to day converter. ! (format "Sun %s %s %s %s" ! (nth 1 date) (nth 0 date) ! (nth 3 date) (nth 2 date))) ! )) ! (setq From_ (format "From %s %s\n" from date)) ! (while (string-match "," From_) ! (setq From_ (concat (substring From_ 0 (match-beginning 0)) ! (substring From_ (match-end 0))))) ! (goto-char (point-min)) ! (insert From_)))))) ! ! ;; The Command Set ! ! ;; AUTHORIZATION STATE ! ! (defun pop3-user (process user) ! "Send USER information to POP3 server." ! (pop3-send-command process (format "USER %s" user)) ! (let ((response (pop3-read-response process t))) ! (if (not (and response (string-match "+OK" response))) ! (error (format "USER %s not valid." user))))) ! ! (defun pop3-pass (process) ! "Send authentication information to the server." ! (let ((pass pop3-password)) ! (if (and pop3-password-required (not pass)) ! (setq pass ! (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) ! (if pass ! (progn ! (pop3-send-command process (format "PASS %s" pass)) ! (let ((response (pop3-read-response process t))) ! (if (not (and response (string-match "+OK" response))) ! (pop3-quit process))))) ! )) ! ! (defun pop3-apop (process user) ! "Send alternate authentication information to the server." ! (if (not (fboundp 'md5)) (autoload 'md5 "md5")) ! (let ((pass pop3-password)) ! (if (and pop3-password-required (not pass)) ! (setq pass ! (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) ! (if pass ! (let ((hash (md5 (concat pop3-timestamp pass)))) ! (pop3-send-command process (format "APOP %s %s" user hash)) ! (let ((response (pop3-read-response process t))) ! (if (not (and response (string-match "+OK" response))) ! (pop3-quit process))))) ! )) ! ! ;; TRANSACTION STATE ! ! (defun pop3-stat (process) ! "Return a list of the number of messages in the maildrop and the size ! of the maildrop." ! (pop3-send-command process "STAT") ! (let ((response (pop3-read-response process t))) ! (list (string-to-int (nth 1 (pop3-string-to-list response))) ! (string-to-int (nth 2 (pop3-string-to-list response)))) ! )) ! ! (defun pop3-list (process &optional msg) ! "Scan listing of available messages. ! This function currently does nothing.") ! ! (defun pop3-retr (process msg crashbuf) ! "Retrieve message-id MSG from the server and place the contents in ! buffer CRASHBUF." ! (pop3-send-command process (format "RETR %s" msg)) ! (pop3-read-response process) ! (let ((start pop3-read-point) end) ! (save-excursion ! (set-buffer (process-buffer process)) ! (while (not (re-search-forward "^\\.\r\n" nil t)) ! (accept-process-output process) ! ;; bill@att.com ... to save wear and tear on the heap ! (if (> (buffer-size) 20000) (sleep-for 1)) ! (if (> (buffer-size) 50000) (sleep-for 1)) ! (if (> (buffer-size) 100000) (sleep-for 1)) ! (if (> (buffer-size) 200000) (sleep-for 1)) ! (if (> (buffer-size) 500000) (sleep-for 1)) ! ;; bill@att.com ! (goto-char start)) ! (setq pop3-read-point (point-marker)) ! (goto-char (match-beginning 0)) ! (setq end (point-marker)) ! (pop3-clean-region start end) ! (pop3-munge-message-separator start end) ! (save-excursion ! (set-buffer crashbuf) ! (erase-buffer)) ! (copy-to-buffer crashbuf start end) ! (delete-region start end) ! ))) ! ! (defun pop3-dele (process msg) ! "Mark message-id MSG as deleted." ! (pop3-send-command process (format "DELE %s" msg)) ! (pop3-read-response process)) ! ! (defun pop3-noop (process msg) ! "No-operation." ! (pop3-send-command process "NOOP") ! (pop3-read-response process)) ! ! (defun pop3-last (process) ! "Return highest accessed message-id number for the session." ! (pop3-send-command process "LAST") ! (let ((response (pop3-read-response process t))) ! (string-to-int (nth 1 (pop3-string-to-list response))) ! )) ! ! (defun pop3-rset (process) ! "Remove all delete marks from current maildrop." ! (pop3-send-command process "RSET") ! (pop3-read-response process)) ! ! ;; UPDATE ! ! (defun pop3-quit (process) ! "Tell server to remove all messages marked as deleted, unlock the ! maildrop, and close the connection." ! (pop3-send-command process "QUIT") ! (pop3-read-response process t) ! (if process ! (save-excursion ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! (delete-process process)))) ! ! ;; Summary of POP3 (Post Office Protocol version 3) commands and responses ! ! ;;; AUTHORIZATION STATE ! ! ;; Initial TCP connection ! ;; Arguments: none ! ;; Restrictions: none ! ;; Possible responses: ! ;; +OK [POP3 server ready] ! ! ;; USER name ! ;; Arguments: a server specific user-id (required) ! ;; Restrictions: authorization state [after unsuccessful USER or PASS ! ;; Possible responses: ! ;; +OK [valid user-id] ! ;; -ERR [invalid user-id] ! ! ;; PASS string ! ;; Arguments: a server/user-id specific password (required) ! ;; Restrictions: authorization state, after successful USER ! ;; Possible responses: ! ;; +OK [maildrop locked and ready] ! ;; -ERR [invalid password] ! ;; -ERR [unable to lock maildrop] ! ! ;;; TRANSACTION STATE ! ! ;; STAT ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK nn mm [# of messages, size of maildrop] ! ! ;; LIST [msg] ! ;; Arguments: a message-id (optional) ! ;; Restrictions: transaction state; msg must not be deleted ! ;; Possible responses: ! ;; +OK [scan listing follows] ! ;; -ERR [no such message] ! ! ;; RETR msg ! ;; Arguments: a message-id (required) ! ;; Restrictions: transaction state; msg must not be deleted ! ;; Possible responses: ! ;; +OK [message contents follow] ! ;; -ERR [no such message] ! ! ;; DELE msg ! ;; Arguments: a message-id (required) ! ;; Restrictions: transaction state; msg must not be deleted ! ;; Possible responses: ! ;; +OK [message deleted] ! ;; -ERR [no such message] ! ! ;; NOOP ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK ! ! ;; LAST ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK nn [highest numbered message accessed] ! ! ;; RSET ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK [all delete marks removed] ! ! ;;; UPDATE STATE ! ! ;; QUIT ! ;; Arguments: none ! ;; Restrictions: none ! ;; Possible responses: ! ;; +OK [TCP connection closed] --- 1,435 ---- ! ;;; pop3.el --- Post Office Protocol (RFC 1460) interface ! ! ;; Copyright (C) 1996, Free Software Foundation, Inc. ! ! ;; Author: Richard L. Pieri ! ;; Keywords: mail, pop3 ! ;; Version: 1.3c ! ! ;; This file is 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: ! ! ;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands ! ;; are implemented. The LIST command has not been implemented due to lack ! ;; of actual usefulness. ! ;; The optional POP3 command TOP has not been implemented. ! ! ;; This program was inspired by Kyle E. Jones's vm-pop program. ! ! ;;; Code: ! ! (require 'mail-utils) ! (provide 'pop3) ! ! (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) ! "*POP3 maildrop.") ! (defvar pop3-mailhost (or (getenv "MAILHOST") nil) ! "*POP3 mailhost.") ! (defvar pop3-port 110 ! "*POP3 port.") ! ! (defvar pop3-password-required t ! "*Non-nil if a password is required when connecting to POP server.") ! (defvar pop3-password nil ! "*Password to use when connecting to POP server.") ! ! (defvar pop3-authentication-scheme 'pass ! "*POP3 authentication scheme. ! Defaults to 'pass, for the standard USER/PASS authentication. Other valid ! values are 'apop.") ! ! (defvar pop3-timestamp nil ! "Timestamp returned when initially connected to the POP server. ! Used for APOP authentication.") ! ! (defvar pop3-read-point nil) ! (defvar pop3-debug nil) ! ! (defun pop3-movemail (&optional crashbox) ! "Transfer contents of a maildrop to the specified CRASHBOX." ! (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) ! (let* ((process (pop3-open-server pop3-mailhost pop3-port)) ! (crashbuf (get-buffer-create " *pop3-retr*")) ! (n 1) ! message-count) ! ;; for debugging only ! (if pop3-debug (switch-to-buffer (process-buffer process))) ! (cond ((equal 'apop pop3-authentication-scheme) ! (pop3-apop process pop3-maildrop)) ! ((equal 'pass pop3-authentication-scheme) ! (pop3-user process pop3-maildrop) ! (pop3-pass process)) ! (t (error "Invalid POP3 authentication scheme."))) ! (setq message-count (car (pop3-stat process))) ! (while (<= n message-count) ! (message (format "Retrieving message %d of %d from %s..." ! n message-count pop3-mailhost)) ! (pop3-retr process n crashbuf) ! (save-excursion ! (set-buffer crashbuf) ! (append-to-file (point-min) (point-max) crashbox) ! (set-buffer (process-buffer process)) ! (while (> (buffer-size) 5000) ! (goto-char (point-min)) ! (forward-line 50) ! (delete-region (point-min) (point)))) ! (pop3-dele process n) ! (setq n (+ 1 n)) ! (if pop3-debug (sit-for 1) (sit-for 0.1)) ! ) ! (pop3-quit process) ! (kill-buffer crashbuf) ! ) ! ) ! ! (defun pop3-open-server (mailhost port) ! "Open TCP connection to MAILHOST. ! Returns the process associated with the connection." ! (let ((process-buffer ! (get-buffer-create (format "trace of POP session to %s" mailhost))) ! (process)) ! (save-excursion ! (set-buffer process-buffer) ! (erase-buffer)) ! (setq process ! (open-network-stream "POP" process-buffer mailhost port)) ! (setq pop3-read-point (point-min)) ! (let ((response (pop3-read-response process t))) ! (setq pop3-timestamp ! (substring response (or (string-match "<" response) 0) ! (+ 1 (or (string-match ">" response) -1))))) ! process ! )) ! ! ;; Support functions ! ! (defun pop3-process-filter (process output) ! (save-excursion ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! (insert output))) ! ! (defun pop3-send-command (process command) ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! ;; (if (= (aref command 0) ?P) ! ;; (insert "PASS \r\n") ! ;; (insert command "\r\n")) ! (setq pop3-read-point (point)) ! (goto-char (point-max)) ! (process-send-string process command) ! (process-send-string process "\r\n") ! ) ! ! (defun pop3-read-response (process &optional return) ! "Read the response from the server. ! Return the response string if optional second argument is non-nil." ! (let ((case-fold-search nil) ! match-end) ! (save-excursion ! (set-buffer (process-buffer process)) ! (goto-char pop3-read-point) ! (while (not (search-forward "\r\n" nil t)) ! (accept-process-output process) ! (goto-char pop3-read-point)) ! (setq match-end (point)) ! (goto-char pop3-read-point) ! (if (looking-at "-ERR") ! (error (buffer-substring (point) (- match-end 2))) ! (if (not (looking-at "+OK")) ! (progn (setq pop3-read-point match-end) nil) ! (setq pop3-read-point match-end) ! (if return ! (buffer-substring (point) match-end) ! t) ! ))))) ! ! (defun pop3-string-to-list (string &optional regexp) ! "Chop up a string into a list." ! (let ((list) ! (regexp (or regexp " ")) ! (string (if (string-match "\r" string) ! (substring string 0 (match-beginning 0)) ! string))) ! (store-match-data nil) ! (while string ! (if (string-match regexp string) ! (setq list (cons (substring string 0 (- (match-end 0) 1)) list) ! string (substring string (match-end 0))) ! (setq list (cons string list) ! string nil))) ! (nreverse list))) ! ! (defvar pop3-read-passwd nil) ! (defun pop3-read-passwd (prompt) ! (if (not pop3-read-passwd) ! (if (load "passwd" t) ! (setq pop3-read-passwd 'read-passwd) ! (autoload 'ange-ftp-read-passwd "ange-ftp") ! (setq pop3-read-passwd 'ange-ftp-read-passwd))) ! (funcall pop3-read-passwd prompt)) ! ! (defun pop3-clean-region (start end) ! (setq end (set-marker (make-marker) end)) ! (save-excursion ! (goto-char start) ! (while (and (< (point) end) (search-forward "\r\n" end t)) ! (replace-match "\n" t t)) ! (goto-char start) ! (while (and (< (point) end) (re-search-forward "^\\." end t)) ! (replace-match "" t t) ! (forward-char))) ! (set-marker end nil)) ! ! (defun pop3-munge-message-separator (start end) ! "Check to see if a message separator exists. If not, generate one." ! (save-excursion ! (save-restriction ! (narrow-to-region start end) ! (goto-char (point-min)) ! (if (not (or (looking-at "From .?") ; Unix mail ! (looking-at "\001\001\001\001\n") ; MMDF ! (looking-at "BABYL OPTIONS:") ; Babyl ! )) ! (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) ! (date (pop3-string-to-list (mail-fetch-field "Date"))) ! (From_)) ! ;; sample date formats I have seen ! ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) ! ;; Date: 08 Jul 1996 23:22:24 -0400 ! ;; should be ! ;; Tue Jul 9 09:04:21 1996 ! (setq date ! (cond ((string-match "[A-Z]" (nth 0 date)) ! (format "%s %s %s %s %s" ! (nth 0 date) (nth 2 date) (nth 1 date) ! (nth 4 date) (nth 3 date))) ! (t ! ;; this really needs to be better but I don't feel ! ;; like writing a date to day converter. ! (format "Sun %s %s %s %s" ! (nth 1 date) (nth 0 date) ! (nth 3 date) (nth 2 date))) ! )) ! (setq From_ (format "From %s %s\n" from date)) ! (while (string-match "," From_) ! (setq From_ (concat (substring From_ 0 (match-beginning 0)) ! (substring From_ (match-end 0))))) ! (goto-char (point-min)) ! (insert From_)))))) ! ! ;; The Command Set ! ! ;; AUTHORIZATION STATE ! ! (defun pop3-user (process user) ! "Send USER information to POP3 server." ! (pop3-send-command process (format "USER %s" user)) ! (let ((response (pop3-read-response process t))) ! (if (not (and response (string-match "+OK" response))) ! (error (format "USER %s not valid." user))))) ! ! (defun pop3-pass (process) ! "Send authentication information to the server." ! (let ((pass pop3-password)) ! (if (and pop3-password-required (not pass)) ! (setq pass ! (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) ! (if pass ! (progn ! (pop3-send-command process (format "PASS %s" pass)) ! (let ((response (pop3-read-response process t))) ! (if (not (and response (string-match "+OK" response))) ! (pop3-quit process))))) ! )) ! ! (defun pop3-apop (process user) ! "Send alternate authentication information to the server." ! (if (not (fboundp 'md5)) (autoload 'md5 "md5")) ! (let ((pass pop3-password)) ! (if (and pop3-password-required (not pass)) ! (setq pass ! (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) ! (if pass ! (let ((hash (md5 (concat pop3-timestamp pass)))) ! (pop3-send-command process (format "APOP %s %s" user hash)) ! (let ((response (pop3-read-response process t))) ! (if (not (and response (string-match "+OK" response))) ! (pop3-quit process))))) ! )) ! ! ;; TRANSACTION STATE ! ! (defun pop3-stat (process) ! "Return the number of messages in the maildrop and the maildrop's size." ! (pop3-send-command process "STAT") ! (let ((response (pop3-read-response process t))) ! (list (string-to-int (nth 1 (pop3-string-to-list response))) ! (string-to-int (nth 2 (pop3-string-to-list response)))) ! )) ! ! (defun pop3-list (process &optional msg) ! "Scan listing of available messages. ! This function currently does nothing.") ! ! (defun pop3-retr (process msg crashbuf) ! "Retrieve message-id MSG to buffer CRASHBUF." ! (pop3-send-command process (format "RETR %s" msg)) ! (pop3-read-response process) ! (let ((start pop3-read-point) end) ! (save-excursion ! (set-buffer (process-buffer process)) ! (while (not (re-search-forward "^\\.\r\n" nil t)) ! (accept-process-output process) ! ;; bill@att.com ... to save wear and tear on the heap ! (if (> (buffer-size) 20000) (sleep-for 1)) ! (if (> (buffer-size) 50000) (sleep-for 1)) ! (if (> (buffer-size) 100000) (sleep-for 1)) ! (if (> (buffer-size) 200000) (sleep-for 1)) ! (if (> (buffer-size) 500000) (sleep-for 1)) ! ;; bill@att.com ! (goto-char start)) ! (setq pop3-read-point (point-marker)) ! (goto-char (match-beginning 0)) ! (insert "\r\n") ! (setq end (point-marker)) ! (pop3-clean-region start end) ! (pop3-munge-message-separator start end) ! (save-excursion ! (set-buffer crashbuf) ! (erase-buffer)) ! (copy-to-buffer crashbuf start end) ! (delete-region start end) ! ))) ! ! (defun pop3-dele (process msg) ! "Mark message-id MSG as deleted." ! (pop3-send-command process (format "DELE %s" msg)) ! (pop3-read-response process)) ! ! (defun pop3-noop (process msg) ! "No-operation." ! (pop3-send-command process "NOOP") ! (pop3-read-response process)) ! ! (defun pop3-last (process) ! "Return highest accessed message-id number for the session." ! (pop3-send-command process "LAST") ! (let ((response (pop3-read-response process t))) ! (string-to-int (nth 1 (pop3-string-to-list response))) ! )) ! ! (defun pop3-rset (process) ! "Remove all delete marks from current maildrop." ! (pop3-send-command process "RSET") ! (pop3-read-response process)) ! ! ;; UPDATE ! ! (defun pop3-quit (process) ! "Close connection to POP3 server. ! Tell server to remove all messages marked as deleted, unlock the maildrop, ! and close the connection." ! (pop3-send-command process "QUIT") ! (pop3-read-response process t) ! (if process ! (save-excursion ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! (delete-process process)))) ! ! ;; Summary of POP3 (Post Office Protocol version 3) commands and responses ! ! ;;; AUTHORIZATION STATE ! ! ;; Initial TCP connection ! ;; Arguments: none ! ;; Restrictions: none ! ;; Possible responses: ! ;; +OK [POP3 server ready] ! ! ;; USER name ! ;; Arguments: a server specific user-id (required) ! ;; Restrictions: authorization state [after unsuccessful USER or PASS ! ;; Possible responses: ! ;; +OK [valid user-id] ! ;; -ERR [invalid user-id] ! ! ;; PASS string ! ;; Arguments: a server/user-id specific password (required) ! ;; Restrictions: authorization state, after successful USER ! ;; Possible responses: ! ;; +OK [maildrop locked and ready] ! ;; -ERR [invalid password] ! ;; -ERR [unable to lock maildrop] ! ! ;;; TRANSACTION STATE ! ! ;; STAT ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK nn mm [# of messages, size of maildrop] ! ! ;; LIST [msg] ! ;; Arguments: a message-id (optional) ! ;; Restrictions: transaction state; msg must not be deleted ! ;; Possible responses: ! ;; +OK [scan listing follows] ! ;; -ERR [no such message] ! ! ;; RETR msg ! ;; Arguments: a message-id (required) ! ;; Restrictions: transaction state; msg must not be deleted ! ;; Possible responses: ! ;; +OK [message contents follow] ! ;; -ERR [no such message] ! ! ;; DELE msg ! ;; Arguments: a message-id (required) ! ;; Restrictions: transaction state; msg must not be deleted ! ;; Possible responses: ! ;; +OK [message deleted] ! ;; -ERR [no such message] ! ! ;; NOOP ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK ! ! ;; LAST ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK nn [highest numbered message accessed] ! ! ;; RSET ! ;; Arguments: none ! ;; Restrictions: transaction state ! ;; Possible responses: ! ;; +OK [all delete marks removed] ! ! ;;; UPDATE STATE ! ! ;; QUIT ! ;; Arguments: none ! ;; Restrictions: none ! ;; Possible responses: ! ;; +OK [TCP connection closed] *** pub/rgnus/lisp/ChangeLog Wed Mar 19 00:04:12 1997 --- rgnus/lisp/ChangeLog Wed Mar 19 21:00:20 1997 *************** *** 1,3 **** --- 1,41 ---- + Wed Mar 19 20:53:34 1997 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.31 is released. + + Wed Mar 19 14:29:26 1997 Lars Magne Ingebrigtsen + + * nnmh.el (nnmh-request-accept-article): Ditto. + + * nnbabyl.el (nnbabyl-request-accept-article): Ditto. + + * nnmbox.el (nnmbox-request-accept-article): Ditto. + + * nnfolder.el (nnfolder-request-accept-article): Ditto. + + * nnml.el (nnml-request-accept-article): Cache or not. + + * gnus-sum.el (gnus-summary-read-group): Don't recurse. + (gnus-summary-ignore-duplicates): New variable. + (gnus-get-newsgroup-headers): Use it. + (gnus-nov-parse-line): Ditto. + + * message.el (message-reply): Remove excessive white space in + headers. + + * nnfolder.el (nnfolder-read-folder): Work when ignoring active + file. + + * nnmail.el (nnmail-process-unix-mail-format): Narrow to the right + portion. + (nnmail-process-mmdf-mail-format): Ditto. + + * gnus.el (gnus-group-remove-parameter): New function. + (gnus-group-set-parameter): Use it. + (gnus-group-add-parameter): Ditto. + + * gnus-msg.el (gnus-post-news): Check first whether + to-list/to-address exists before adding. + Tue Mar 18 23:54:17 1997 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.4.30 is released. *** pub/rgnus/texi/gnus.texi Wed Mar 19 00:04:16 1997 --- rgnus/texi/gnus.texi Wed Mar 19 21:00:27 1997 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Gnus 5.4.30 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Gnus 5.4.31 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 287,293 **** @tex @titlepage ! @title Gnus 5.4.30 Manual @author by Lars Magne Ingebrigtsen @page --- 287,293 ---- @tex @titlepage ! @title Gnus 5.4.31 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 323,329 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Gnus 5.4.30 @end ifinfo --- 323,329 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Gnus 5.4.31. @end ifinfo *************** *** 6761,6766 **** --- 6761,6777 ---- it to, for instance, highlight lines or modify the look of the buffer in some other ungodly manner. I don't care. + @vindex gnus-summary-ignore-duplicates + @item gnus-summary-ignore-duplicates + When Gnus discovers two articles that have the same @code{Message-ID}, + it has to do something drastic. No articles are allowed to have the + same @code{Message-ID}, but this may happen when reading mail from some + sources. Gnus allows you to customize what happens with this variable. + If it is @code{nil} (which is the default), Gnus will rename the + @code{Message-ID} (for display purposes only) and display the article as + any other article. If this variable is @code{t}, it won't display the + article---it'll be as if it never existed. + @end table *************** *** 8861,8866 **** --- 8872,8883 ---- @vindex nnmail-delete-file-function @findex delete-file Function called to delete files. It is @code{delete-file} by default. + + @item nnmail-cache-accepted-message-ids + @vindex nnmail-cache-accepted-message-ids + If non-@code{nil}, put the @code{Message-ID}s of articles imported into + the backend (via @code{Gcc}, for instance) into the mail duplication + discovery cache. The default is @code{nil}. @end table *** pub/rgnus/texi/message.texi Sat Mar 1 03:54:56 1997 --- rgnus/texi/message.texi Wed Mar 19 21:00:27 1997 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Message Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Message 5.4.31 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 12,18 **** @ifinfo ! This file documents Messa, the Emacs message composition mode. Copyright (C) 1996 Free Software Foundation, Inc. --- 12,18 ---- @ifinfo ! This file documents Message, the Emacs message composition mode. Copyright (C) 1996 Free Software Foundation, Inc. *************** *** 39,45 **** @tex @titlepage ! @title Message Manual @author by Lars Magne Ingebrigtsen @page --- 39,45 ---- @tex @titlepage ! @title Message 5.4.31 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 78,83 **** --- 78,87 ---- * Index:: Variable, function and concept index. * Key Index:: List of Message mode keys. @end menu + + This manual corresponds to Message 5.4.31. Message is distributed with + the Gnus distribution bearing the same version number as this manual + has. @node Interface *** pub/rgnus/texi/ChangeLog Tue Mar 18 18:02:02 1997 --- rgnus/texi/ChangeLog Wed Mar 19 21:00:27 1997 *************** *** 1,3 **** --- 1,8 ---- + Wed Mar 19 15:45:17 1997 Lars Magne Ingebrigtsen + + * gnus.texi (Various Summary Stuff): Addition. + (Mail Backend Variables): Addition. + Tue Mar 18 14:43:32 1997 Lars Magne Ingebrigtsen * gnus.texi (Article Washing): Not addition.