Changeset 3305

Show
Ignore:
Timestamp:
06/24/08 08:14:42 (7 months ago)
Author:
hans
Message:

Perform QP-encoding of outgoing headers. CL-SMTP does it, but it
does so simple-mindedly which breaks some address parsers (namely
that of Google Mail).

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/lisp-ecoop/src/mail.lisp

    r2788 r3305  
    1111                          (setf mail-address embedded-mail-address)) 
    1212    mail-address)) 
     13 
     14(defun maybe-encode-qp (string &optional (external-format (flex:make-external-format :utf-8))) 
     15  (if (find-if (lambda (char) (< 127 (char-code char))) string) 
     16      (with-output-to-string (s) 
     17        (format s "=?~A?Q?" (flex:external-format-name external-format)) 
     18        (loop for char across string 
     19           do (if (< 127 (char-code char)) 
     20                  (loop for byte across (flex:string-to-octets (make-string 1 :initial-element char) 
     21                                                               :external-format external-format) 
     22                     do (format s "=~2,'0X" byte)) 
     23                  (write-char char s))) 
     24        (format s "?=")) 
     25      string)) 
    1326 
    1427(defmethod user-send-mail ((user user) 
    …… 
    2538      (format smtp "Date: ~A~%" (format-date-time (get-universal-time) :mail-style t)) 
    2639      (format smtp "From: ~A~%" from) 
    27       (format smtp "To: ~A <~A>~%" (user-full-name user) (user-email user)) 
     40      (format smtp "To: ~A <~A>~%" (maybe-encode-qp (user-full-name user)) (user-email user)) 
    2841      (when cc 
    2942        (format smtp "Cc: ~A~%" cc)) 
    30       (format smtp "Subject: ~A~%" subject) 
     43      (format smtp "Subject: ~A~%" (maybe-encode-qp subject)) 
    3144      (format smtp "Content-Type: ~A; charset=utf-8~%" content-type) 
    3245      (format smtp "X-Mailer: BKNR Mail Version 1.1~%")