2009-10-13 02:42 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

* contrib/hbtip/sendmail.prg
    + Fixed to allow inclusion of descriptive name in "from" address.

  * contrib/hbtip/mail.prg
    * Minor formatting.
    + Apply Q encoding to subject/from/to fields.
      (descriptive name part only for from/to fields)
    ; NOTE: Please make necessary corrections.

  * contrib/hbtip/encqp.prg
    ! Also encode ASC 127.
    + Also encode a few more chars to make EBDIC systems happy 
      in sync with RFC recommendation.

  * contrib/hbtip/client.prg
    + Changed to make CR LF chars appear in log output.

harbour/ChangeLog

@@ -17,6 +17,24 @@
    past entries belonging to author(s): Viktor Szakats.
 */
 
+2009-10-13 02:42 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
+  * contrib/hbtip/sendmail.prg
+    + Fixed to allow inclusion of descriptive name in "from" address.
+
+  * contrib/hbtip/mail.prg
+    * Minor formatting.
+    + Apply Q encoding to subject/from/to fields.
+      (descriptive name part only for from/to fields)
+    ; NOTE: Please make necessary corrections.
+
+  * contrib/hbtip/encqp.prg
+    ! Also encode ASC 127.
+    + Also encode a few more chars to make EBDIC systems happy 
+      in sync with RFC recommendation.
+
+  * contrib/hbtip/client.prg
+    + Changed to make CR LF chars appear in log output.
+
 2009-10-13 00:21 UTC+0200 Francesco Saverio Giudice (info/at/fsgiudice.com)
   * harbour/src/rtl/hbini.prg
      * Changed hb_IniString() function name to hb_IniReadStr()

harbour/contrib/hbtip/client.prg

@@ -794,7 +794,7 @@ METHOD Log( ... ) CLASS tIPClient
 
          // Preserves CRLF on result
          IF xVar:__enumIndex() < PCount()
-            cMsg += StrTran( StrTran( AllTrim( hb_CStr( xVar ) ), Chr( 13 ) ), Chr( 10 ) )
+            cMsg += StrTran( StrTran( AllTrim( hb_CStr( xVar ) ), Chr( 13 ), "<cr>" ), Chr( 10 ), "<lf>" )
          ELSE
             cMsg += hb_CStr( xVar )
          ENDIF

harbour/contrib/hbtip/encqp.prg

@@ -71,8 +71,8 @@ METHOD Encode( cData ) CLASS TIPEncoderQP
       IF c == Chr( 13 )
          cString += Chr( 13 ) + Chr( 10 )
          nLineLen := 0
-      ELSEIF Asc( c ) > 127 .OR. ;
-         c == "=" .OR. ;
+      ELSEIF Asc( c ) > 126 .OR. ;
+         c $ '=?!"#$@[\]^`{|}~' .OR. ;
          ( Asc( c ) < 32 .AND. !( c $ Chr( 13 ) + Chr( 10 ) + Chr( 9 ) ) ) .OR. ;
          ( c $ " " + Chr( 9 ) .AND. SubStr( cData, c:__enumIndex() + 1 ) $ Chr( 13 ) + Chr( 10 ) )
          IF nLineLen + 3 > 76

harbour/contrib/hbtip/mail.prg

@@ -68,7 +68,7 @@ CREATE CLASS TipMail
    // received fields may be more than once.
    VAR aReceived INIT {}
 
-   METHOD New( cBody, oEncoder )    Constructor
+   METHOD New( cBody, oEncoder )    CONSTRUCTOR
    METHOD SetBody( cBody )
    METHOD GetBody()
    METHOD GetRawBody()              INLINE ::cBody
@@ -282,7 +282,7 @@ METHOD ToString() CLASS TipMail
    ENDIF
 
    IF Len( ::aAttachments ) > 0
-      //Reset failing content type
+      // reset failing content type
       IF At( "multipart/", Lower( ::GetFieldPart( "Content-Type" ) ) ) == 0
          ::hHeaders[ "Content-Type" ] := "multipart/mixed"
       ENDIF
@@ -313,13 +313,13 @@ METHOD ToString() CLASS TipMail
       cRet += "Date: " + ::hHeaders[ "Date" ] + e"\r\n"
    ENDIF
    IF "From" $ ::hHeaders
-      cRet += "From: " + ::hHeaders[ "From" ] + e"\r\n"
+      cRet += "From: " + LTrim( WordEncodeQ( tip_GetNameEMail( ::hHeaders[ "From" ] ), ::cCharset ) + " <" + tip_GetRawEMail( ::hHeaders[ "From" ] ) + ">" ) + e"\r\n"
    ENDIF
    IF "To" $ ::hHeaders
-      cRet += "To: " + ::hHeaders[ "To" ] + e"\r\n"
+      cRet += "To: " + LTrim( WordEncodeQ( tip_GetNameEMail( ::hHeaders[ "To" ] ), ::cCharset ) + " <" + tip_GetRawEMail( ::hHeaders[ "To" ] ) + ">" ) + e"\r\n"
    ENDIF
    IF "Subject" $ ::hHeaders
-      cRet += "Subject: " + ::hHeaders[ "Subject" ] + e"\r\n"
+      cRet += "Subject: " + WordEncodeQ( ::hHeaders[ "Subject" ], ::cCharset ) + e"\r\n"
    ENDIF
    IF Len( ::aAttachments ) > 0
       cRet += "Mime-Version:" + ::hHeaders[ "Mime-Version" ] + e"\r\n"
@@ -516,7 +516,7 @@ METHOD MakeBoundary() CLASS TipMail
 METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
    LOCAL aTo, aCC, aBCC, i, imax
 
-   IF ! ISCHARACTER( csubject )
+   IF ! ISCHARACTER( cSubject )
       cSubject := ""
    ENDIF
 
@@ -662,3 +662,57 @@ METHOD getMultiParts( aParts ) CLASS TipMail
    ENDIF
 
    RETURN aParts
+
+STATIC FUNCTION WordEncodeQ( cData, cCharset )
+   LOCAL c
+   LOCAL cString
+   LOCAL nLineLen := 0
+   LOCAL lToEncode := .F.
+
+   IF Empty( cCharset )
+      RETURN cData
+   ENDIF
+
+   /* TOFIX: Add support to handle long string. */
+
+   cString := "=?" + cCharset + "?" + "Q" + "?"
+
+   FOR EACH c IN cData
+      IF c == " "
+         cString += "_"
+         nLineLen += 1
+      ELSEIF Asc( c ) > 126 .OR. ;
+         c $ '=?!"#$@[\]^`{|}~' .OR. ;
+         Asc( c ) <= 32
+         cString += "=" + hb_NumToHex( Asc( c ), 2 )
+         nLineLen += 3
+         lToEncode := .T.
+      ELSE
+         cString += c
+         nLineLen += 1
+      ENDIF
+   NEXT
+
+   RETURN iif( lToEncode, cString + "?=", cData )
+
+FUNCTION tip_GetRawEMail( cAddress )
+   LOCAL tmp, tmp1
+
+   IF ( tmp := At( "<", cAddress ) ) > 0
+      IF ( tmp1 := hb_At( ">", cAddress, tmp + 1 ) ) > 0
+         RETURN SubStr( cAddress, tmp + 1, tmp1 - tmp - 1 )
+      ENDIF
+   ENDIF
+
+   RETURN cAddress
+
+FUNCTION tip_GetNameEMail( cAddress )
+   LOCAL tmp
+
+   IF ( tmp := At( "<", cAddress ) ) > 0
+      IF hb_At( ">", cAddress, tmp + 1 ) > 0
+         RETURN RTrim( Left( cAddress, tmp - 1 ) )
+      ENDIF
+   ENDIF
+
+   RETURN cAddress

harbour/contrib/hbtip/sendmail.prg

@@ -95,6 +95,8 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
    LOCAL lConnect      := .T.
    LOCAL oPop
 
+   LOCAL cFromRaw := tip_GetRawEMail( cFrom )
+
    IF ! ISCHARACTER( cServer ) .OR. Empty( cServer )
       cServer := "localhost"
    ENDIF
@@ -267,15 +269,15 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
    oMail:hHeaders[ "Date" ] := tip_Timestamp()
    oMail:hHeaders[ "From" ] := cFrom
 
+   IF ! Empty( cReplyTo )
+      oMail:hHeaders[ "Reply-to" ] := cReplyTo
+   ENDIF
    IF ! Empty( cCC )
       oMail:hHeaders[ "Cc" ] := cCC
    ENDIF
    IF ! Empty( cBCC )
       oMail:hHeaders[ "Bcc" ] := cBCC
    ENDIF
-   IF ! Empty( cReplyTo )
-      oMail:hHeaders[ "Reply-To" ] := cReplyTo
-   ENDIF
 
    BEGIN SEQUENCE
       oInmail := tIPClientSMTP():New( oUrl, bTrace )
@@ -365,7 +367,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
 
    ENDIF
 
-   oInMail:oUrl:cUserid := cFrom
+   oInMail:oUrl:cUserid := cFromRaw
 
    oMail:hHeaders[ "To" ] := cTo
    oMail:hHeaders[ "Subject" ] := cSubject
@@ -447,7 +449,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
    NEXT
 
    IF lRead
-      oMail:hHeaders[ "Disposition-Notification-To" ] := cFrom
+      oMail:hHeaders[ "Disposition-Notification-To" ] := cFromRaw
    ENDIF
 
    IF nPriority != 3
@@ -462,7 +464,6 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
 
 //-------------------------------------------------------------//
 
-
 FUNCTION hb_SetMimeType( cFile, cFname, cFext )
 
    cFile := Lower( cFile )