epsilon fix/customization

[MILLER@VAX.CAM.NIST.GOV]

Thanks to all who commented and offered help.
I went ahead and hacked my own `solution' to the mail header problem.
In all fairness to Symbolics, let me reiterate Barmar's point that it
is not at all clear that the symbolics side of DNA mail SHOULD look for the embedded
headers. It seems to be, partly at least, a clash between DNA & Internet.
In that sense, the following should be considered a customization rather than
a bug-fix.  Internet mail forwarded from one vax to another vax would likely 
have the same junk headers in its body, although the 2nd vax would not try to 
make anything out of them.  Regarding Bryan's comment; it is indeed the lispm that is
added the offending (but required!) header, although in some cases my vax (presumably
the exlan software which recieves the original internet message?) is apparently
adding its own recieved line, which it should, but it should not add a blank line, which
it does...

In any case, I wanted it to work this way instead of that, and apparently I'm not alone.
I've only tried it out on a few tests, sending mail to myself via this, that and the other,
and I received my morning mail with no problems.  It goes slightly beyond my original
proposed solution in that it is quite liberal about ignoring blank lines on input and
it usesd the latest subject header as the message subject.
With the caveats above and in the code, here it is:

To complete the patch, insert this line 

 (setq subject-line
       (handle-additional-header-lines stream header-stream subject-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.
[I didn't include any symbolics code here!]

Have fun;
Bruce
MILLER@VAX.CAM.NIST.GOV

PS. The stuff below is ugly cause I took the fonts out; The people who want this patch
dont want fonts yet!

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: DNA; Base: 10; Patch-File: Yes -*-
;;;> ******************************************************************************************
;;;; The problem:
;;; DNA has special roles for FROM, TO & SUBJECT.  The Lispm's DNA software (DNA-MAIL server)
;;; extracts these fields and writes them into the output message followed by a blank line.
;;; This is fine for the simple case of mail being send directly from the vax to a lispm.  But it ignores
;;; what happens if mail is being forwarded by a VAX; because then it already has a lot
;;; of header info. That header info is now separated from the top by a blank line and will  be
;;; invisible to ZMAIL. The result is that character-style info is ignored and your message contains all
;;; sorts of obnoxious header stuff that is not meant for human eyes. (for example)
;;;; The Solution:
;;; The software should check if what it thinks is the message body actually contains some more
;;; headers, and if so, it should include those with the other headers before the blank line.
;;; Note that the check for whether a line is intended to be a header is not completely foolproof;
;;; but we do our best.  We have to read in a line in order to find out whether it is a header or not. If
;;; not, we simply decline to advance-input-buffer in order to `un-read' it.
;;; Other details:
;;;    The subject that is originally gotten is sometimes rather arbitrary; a subject line in the extra
;;; headers is often better. Furthermore, ZMAIL crashed when I gave it a message with more than one
;;; subject.  So, we will only include one subject line, the one from the last subject line read.
;;;    Also note the CR handling & DISGUSTING-NEWLINE-KLUDGE
;;;    Finally, because of the VAX mailer is ALSO inserting blank lines after the headers it inserts, 
;;; I am being rather liberal about stopping when I get a blank line.
;;;; Caveats
;;; 1) As Barry Margolin has pointed out, deciding if the text is meant to be headers is more than just
;;; a question of ambiguity; Maybe a vax user is mailing me a Memo!!!
;;; 2) Be forewarned that the current code IGNORES blank lines as a marker for ending the headers!

;;; This function copys any additional header lines from STREAM and hands them over to the
;;; HEADER-STREAM.  In the process it prunes out any subject lines, but sets subject-line to the last
;;; such line read (and returns it).  This subject-line should be used in the header rather than the one
;;; that came out of the DNA packet.

(defun handle-additional-header-lines (stream header-stream subject-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)
			 (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))
    subject-line))

;;; To complete the patch, insert this line 

;;; (setq subject-line
;;;       (handle-additional-header-lines stream header-stream subject-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.