epsilon fix/customization

["TSD::AIP1::\"Len%HEART-OF-GOLD\"%atc.bendix.com %RELAY.CS.NET"@WARBUCKS.AI.SRI.COM]

Date: Fri, 29 Sep 89 09:23 EDT
From: Len Moskowitz <Len@HEART-OF-GOLD>
Reply-To: moskowitz%bendix.com@relay.cs.net
Subject: epsilon fix/customization
To: "3077::IN%\"slug@warbucks.ai.sri.com\""@TSD1
In-Reply-To: Your message of 14 Sep 89 08:53 EDT
Message-ID: <19890929132304.2.LEN@HEART-OF-GOLD>
Character-Type-Mappings: (1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")
Fonts: CPTFONT, CPTFONTCB
 
For all the DNA users:
 
Here's a simple extension of Bruce Miller's epsilon patch that partially fixes
the wrongly generated reply address problem.  If the message has an address in
a Reply-to: field, Zmail will use it for the To: address in replies.
 
------
 
;;; Maybe while we're at it, we can add a fix for the REPLY-TO: header line. -
;;; LM 9/20/89 09:19:08
 
(DEFUN REPLY-TO-LINE-P (LINE)
  (STRING-SEARCH "Reply-to:" LINE))
 
;;; If the message had a Reply-to: field, we stuff the address into sender-line.  We let this
;;; function return multiple values.
 
(defun handle-additional-header-lines (stream header-stream subject-line sender-line)
  (let ((whitespace '(#\space #\tab #\return))
	(cant-continue-p t)
	(headers nil)
	buffer start end)
    (flet ((copy ()
	     (let ((new (cl:make-array (- end start) :element-type 'cl:string-char)))
	       (copy-array-portion buffer start end new 0 (- end start))
	       new)))
      ;; Must set this here so last buffer we read (which fails header test) will have CR in it
      ;; [See SYS:DNA;DNA-USER & SYS:DNA;DNA-MAIL] We need the CR's anyway.
      (send stream :set-disgusting-newline-kludge t)	; Makes sure we get real CR's
      (loop do					; For each line of input from the `message'.
	(setf (values buffer start end)(send stream :read-input-buffer))
	(let ((i start))
	  ;; Case 1: Line starts with whitespace -> blank line or `continuation' line (if something to cont.)
	  (cond ((or ( i end)(member (aref buffer i) whitespace))
		 (loop while (and (< i end)(member (aref buffer i) whitespace)) do (incf i))
		 (cond (( i end)(setq cant-continue-p T))	; Ignore blank lines, for now
		       ;; If you dont like that the put (RETURN) in place of the setq.
		       (cant-continue-p (RETURN))	; This must be message body
		       (T (push (copy) headers))))	; A continued line.
		;; Case 2: potentially a header. Must have hyphenated word followed by :
		(T (loop while (and (< i end)
				    (or (alpha-char-p (aref buffer i))
					(eql (aref buffer i) #\-)))
			 do (incf i))
		   (unless (and (> i start)(eql (aref buffer i) #\:))
		     (return))			; Done if failed header test.
		   (let ((header (copy)))
		     (if (subject-line-p header)	; If subject line, use this line instead
			 (setq subject-line header	; Note: If subject continues, then problems!!!
			       cant-continue-p T)
			 1;; Added the IF and the first condition - LM 9/20/890 109:25:18
0			 ;; Assume that if there's a Reply-to: field, it has the correct sender
			 ;; address.
			 (if (reply-to-line-p header)	; If reply-to line, use this line instead
			     (setq sender-line header	; Note: If reply-to continues, then problems!!!
				   cant-continue-p T)
			     (setq headers (cons header headers)	; Otherwise, stick it with others.
			       cant-continue-p nil)))))))
	       ;; Unless we're out of the loop, absorb whatever it was we read.
	(send stream :advance-input-buffer end)))
    ;; Now put all header lines into the header stream, Yes, in reverse order!
    (loop for header in headers do
      (send header-stream :add-header-line header))
    1;; Return multiple values - LM 9/20/89 10:10:08
0    (values subject-line sender-line)))
 
 
To complete the patch, insert this line 
		 ;; 1Added by LM 9/19/89 17:18:25
0		 (scl:multiple-value-setq (subject-line sender-line) 
					(handle-additional-header-lines stream header-stream subject-line sender-line))
into the method (:SERVER-TOP-LEVEL DNA-MAIL-SERVER) in SYS:DNA;DNA-MAIL right after
the line that adds a #\RETURN to the header using :ADD-HEADER-LINE.