diff --git a/collects/mzlib/date.ss b/collects/mzlib/date.ss index 68cca00..4583ae6 100644 --- a/collects/mzlib/date.ss +++ b/collects/mzlib/date.ss @@ -44,7 +44,7 @@ |# (define legal-formats - (list 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601)) + (list 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc822)) (define date-display-format (make-parameter 'american @@ -142,6 +142,17 @@ (values (list year "-" (add-zero (date-month date)) "-" (add-zero (date-day date))) (list " " hour24 ":" minute ":" second))] + [(rfc822) + (values + (list (substring week-day 0 3) ", " day " " (substring month 0 3) " " year) + (list* " " hour24 ":" minute ":" second " " + (let* ([delta (date-time-zone-offset date)] + [hours (quotient delta 3600)] + [minutes (modulo (quotient delta 60) 60)]) + (list + (if (negative? delta) "-" "") + (add-zero (abs hours)) + (add-zero minutes)))))] [else (error 'date->string "unknown date-display-format: ~s" (date-display-format))])]) (apply string-append (if time? diff --git a/collects/net/head-unit.ss b/collects/net/head-unit.ss index 3f5e8db..9a03f33 100644 --- a/collects/net/head-unit.ss +++ b/collects/net/head-unit.ss @@ -1,6 +1,7 @@ (module head-unit mzscheme - (require (lib "unitsig.ss")) + (require (lib "unitsig.ss") + (lib "date.ss")) (require "head-sig.ss") @@ -139,7 +140,10 @@ (define (standard-message-header from tos ccs bccs subject) (let ([h (insert-field "Subject" subject - empty-header)]) + (insert-field + "Date" (parameterize ([date-display-format 'rfc822]) + (date->string (seconds->date (current-seconds)) #t)) + empty-header))]) ;; NOTE: bccs don't go into the header; that's why ;; they're "blind" (let ([h (if (null? ccs)