From 790f8fc2909e3b9f2df7d4cb4393c41599040b87 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Tue, 13 Oct 2009 00:44:12 +0000 Subject: [PATCH] 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 | 18 ++++++++ harbour/contrib/hbtip/client.prg | 2 +- harbour/contrib/hbtip/encqp.prg | 4 +- harbour/contrib/hbtip/mail.prg | 66 +++++++++++++++++++++++++++--- harbour/contrib/hbtip/sendmail.prg | 13 +++--- 5 files changed, 88 insertions(+), 15 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 27675b9d9f..f0dd544aa5 100644 --- a/harbour/ChangeLog +++ b/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() diff --git a/harbour/contrib/hbtip/client.prg b/harbour/contrib/hbtip/client.prg index 6bc289e6a6..38374c44b3 100644 --- a/harbour/contrib/hbtip/client.prg +++ b/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 ), "" ), Chr( 10 ), "" ) ELSE cMsg += hb_CStr( xVar ) ENDIF diff --git a/harbour/contrib/hbtip/encqp.prg b/harbour/contrib/hbtip/encqp.prg index 9299e95a30..0be027d514 100644 --- a/harbour/contrib/hbtip/encqp.prg +++ b/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 diff --git a/harbour/contrib/hbtip/mail.prg b/harbour/contrib/hbtip/mail.prg index 2ee41be31e..18b6ab907f 100644 --- a/harbour/contrib/hbtip/mail.prg +++ b/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 diff --git a/harbour/contrib/hbtip/sendmail.prg b/harbour/contrib/hbtip/sendmail.prg index 9c6b3ce534..fb3022b976 100644 --- a/harbour/contrib/hbtip/sendmail.prg +++ b/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 )