From d08694751a14a6222ee6d10555b28a9cb42b8047 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 24 Oct 2005 02:23:41 +0000 Subject: [PATCH] Fix bug #14354: use email address and ctime() string in message separator of FCC files, because they are supposed to be unix-mail files. Also add "Date" and "From" headers, and don't output a newline before the first message in a file. --- v7/src/edwin/sendmail.scm | 38 ++++++++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 12 deletions(-) diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm index 61629383e..5b117dfc1 100644 --- a/v7/src/edwin/sendmail.scm +++ b/v7/src/edwin/sendmail.scm @@ -1,9 +1,10 @@ #| -*-Scheme-*- -$Id: sendmail.scm,v 1.85 2004/10/29 20:05:06 cph Exp $ +$Id: sendmail.scm,v 1.86 2005/10/24 02:23:41 cph Exp $ Copyright 1991,1992,1993,1994,1995,1996 Massachusetts Institute of Technology Copyright 1997,1998,2000,2001,2003,2004 Massachusetts Institute of Technology +Copyright 2005 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -694,9 +695,12 @@ the user from the mailer." (lambda (name value) (if (and value (not (mail-field-start h-start h-end name))) (mail-insert-field-value h-end name value))))) + (add-field "Date" (universal-time->string (get-universal-time))) ;; If there is a From and no Sender, put in a Sender. - (if (mail-field-start h-start h-end "From") - (add-field "Sender" (mail-from-string mail-buffer))) + (add-field (if (mail-field-start h-start h-end "From") + "Sender" + "From") + (mail-from-string mail-buffer)) (add-field "Organization" (mail-organization-string mail-buffer)) (add-field "User-Agent" (mailer-version-string mail-buffer))) (let ((v (receiver h-start h-end b-start b-end))) @@ -743,14 +747,18 @@ the user from the mailer." (if (ref-variable mail-relay-host lookup-context) (let ((recipients (compute-message-recipients h-start h-end))) (write-message-file h-start h-end b-start b-end message-pathname) - (write-fcc-messages fcc-pathnames message-pathname) + (write-fcc-messages fcc-pathnames + message-pathname + lookup-context) (lambda () (send-mail-using-smtp message-pathname recipients lookup-context))) (begin (write-message-file h-start h-end b-start b-end message-pathname) - (write-fcc-messages fcc-pathnames message-pathname) + (write-fcc-messages fcc-pathnames + message-pathname + lookup-context) (lambda () (send-mail-using-sendmail message-pathname lookup-context)))) message-pathname))))) @@ -787,17 +795,18 @@ the user from the mailer." (mark-temporary! m) pathnames))))) -(define (write-fcc-messages pathnames message-pathname) +(define (write-fcc-messages pathnames message-pathname lookup-context) (for-each (let ((append-message (let ((header-line (string-append "From " - (current-user-name) + (user-mail-address lookup-context) " " - (universal-time->string (get-universal-time))))) - (lambda (port) - (newline port) + (universal-time->local-ctime-string (get-universal-time))))) + (lambda (length port) + (if (> length 0) + (newline port)) (write-string header-line port) (newline port) (call-with-input-file message-pathname @@ -820,8 +829,13 @@ the user from the mailer." (lambda (pathname) (let ((buffer (pathname->buffer pathname))) (if buffer - (call-with-output-mark (buffer-end buffer) append-message) - (call-with-append-file pathname append-message))))) + (call-with-output-mark (buffer-end buffer) + (lambda (port) + (append-message (buffer-length buffer) port))) + (call-with-append-file pathname + (lambda (port) + (append-message ((port/operation port 'LENGTH) port) + port))))))) pathnames)) (define (compute-message-recipients h-start h-end) -- 2.25.1