From 873c60d54fe8d22d69dadc4a9caf526e739b64fd Mon Sep 17 00:00:00 2001 From: "Jean Lefebvre (Mafact)" Date: Thu, 29 Jan 2015 23:57:12 +0100 Subject: [PATCH] 2015-01-29 23:55 UTC+0100 Jean Lefebvre (jfl/at/mafact.com) 2015-01-29 23:55 UTC+0100 Jean Lefebvre (jfl/at/mafact.com) * contrib/hbtip/sendmail.prg * Modified hb_sendmail(...) to allow TLS on port 587 No change in parameters * contrib/hbtip/client.prg + added FUNCTION ActivateSSL(Self) * changed all actual ref to TLS to SSL for clarity with real TLS vars and methods * contrib/hbtip/smtpcli.prg + Added METHOD StartTLS() to allow starting SSL crypting after receiving the STARTTLS command only + Added METHOD DetectSecurity() to initiate Authentification methods reading 250-xxx lines * contrib/hbtip/tests/gmail.prg * changed comment to explain TLS on port 587 for gmail * changed port to 587 to allow testing * Auto detect SSL on 465 and plain text on 587 (till STARTTLS command) --- ChangeLog.txt | 16 ++++++ contrib/hbtip/client.prg | 54 +++++++++++++------- contrib/hbtip/sendmail.prg | 47 +++++++---------- contrib/hbtip/smtpcli.prg | 96 ++++++++++++++++++++++++++++------- contrib/hbtip/tests/gmail.prg | 13 +++-- 5 files changed, 157 insertions(+), 69 deletions(-) diff --git a/ChangeLog.txt b/ChangeLog.txt index 13c92a3269..ad8fd90a0b 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -10,6 +10,22 @@ * Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment */ +2015-01-29 23:55 UTC+0100 Jean Lefebvre (jfl/at/mafact.com) + * contrib/hbtip/sendmail.prg + * Modified hb_sendmail(...) to allow TLS on port 587 + No change in parameters + * contrib/hbtip/client.prg + + added FUNCTION ActivateSSL(Self) + * changed all actual ref to TLS to SSL for clarity with real TLS vars and methods + * contrib/hbtip/smtpcli.prg + + Added METHOD StartTLS() to allow starting SSL crypting after receiving the STARTTLS command only + + Added METHOD DetectSecurity() to initiate Authentification methods reading 250-xxx lines + * contrib/hbtip/tests/gmail.prg + * changed comment to explain TLS on port 587 for gmail + * changed port to 587 to allow testing + * Auto detect SSL on 465 and plain text on 587 (till STARTTLS command) + + 2015-01-19 13:24 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * contrib/hbwin/hbwin.hbx + added __oleVariantNullDate() diff --git a/contrib/hbtip/client.prg b/contrib/hbtip/client.prg index 5835d08eb7..f586e65f4e 100644 --- a/contrib/hbtip/client.prg +++ b/contrib/hbtip/client.prg @@ -4,6 +4,7 @@ * * Copyright 2003 Giancarlo Niccolai * Copyright 2009 Viktor Szakats (vszakats.net/harbour) (SSL support) + * Copyright 2015 Jean Lefebvre (TLS support) * www - http://harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -62,6 +63,10 @@ Added data ::nWrite to work like ::nRead 2009-06-29, Luiz Rafael Culik (luiz at xharbour dot com dot br) Added support for proxy connection + 2015-01-29, Jean Lefebvre + added FUNCTION ActivateSSL(Self) + to be used here and into smtpcli (needed to post activate SSL as request in TLS) + Also, changed all reference to TLS to SSL */ #include "hbclass.ch" @@ -115,7 +120,7 @@ CREATE CLASS TIPClient VAR exGauge /* Gauge control; it can be a codeblock or a function pointer. */ - VAR lTLS INIT .F. + VAR lSSL INIT .F. VAR lHasSSL INIT tip_SSL() VAR ssl_ctx @@ -133,7 +138,7 @@ CREATE CLASS TIPClient METHOD New( oUrl, xTrace, oCredentials ) METHOD Open( cUrl ) - METHOD EnableTLS( lEnable ) + METHOD EnableSSL( lEnable ) METHOD Read( nLen ) METHOD ReadToFile( cFile, nMode, nSize ) @@ -229,7 +234,7 @@ METHOD New( oUrl, xTrace, oCredentials ) CLASS TIPClient oURL:cProto == "https" .OR. ; oURL:cProto == "pop3s" .OR. oURL:cProto == "pops" .OR. ; oURL:cProto == "smtps" - ::EnableTLS( .T. ) + ::EnableSSL( .T. ) ENDIF ENDIF @@ -273,11 +278,11 @@ METHOD Open( cUrl ) CLASS TIPClient RETURN .T. -METHOD EnableTLS( lEnable ) CLASS TIPClient +METHOD EnableSSL( lEnable ) CLASS TIPClient LOCAL lSuccess - IF ::lTLS == lEnable + IF ::lSSL == lEnable RETURN .T. ENDIF @@ -285,14 +290,14 @@ METHOD EnableTLS( lEnable ) CLASS TIPClient IF ::lHasSSL ::ssl_ctx := SSL_CTX_new() ::ssl := SSL_new( ::ssl_ctx ) - ::lTLS := .T. + ::lSSL := .T. lSuccess := .T. ELSE lSuccess := .F. ENDIF ELSE IF ::lHasSSL - ::lTLS := .F. + ::lSSL := .F. lSuccess := .T. ELSE lSuccess := .T. @@ -368,7 +373,7 @@ METHOD Close() CLASS TIPClient nRet := hb_inetClose( ::SocketCon ) - IF ::lHasSSL .AND. ::lTLS + IF ::lHasSSL .AND. ::lSSL SSL_shutdown( ::ssl ) ::ssl := NIL ::ssl_ctx := NIL @@ -423,7 +428,7 @@ METHOD Read( nLen ) CLASS TIPClient // read an amount of data cStr0 := Space( nLen ) - IF ::lTLS + IF ::lSSL IF ::lHasSSL /* Getting around implementing the hack used in non-SSL branch for now. IMO the proper fix would have been done to hb_inetRecvAll(). [vszakats] */ @@ -593,7 +598,7 @@ METHOD inetSendAll( SocketCon, cData, nLen ) CLASS TIPClient nLen := Len( cData ) ENDIF - IF ::lTLS + IF ::lSSL IF ::lHasSSL #if defined( _SSL_DEBUG_TEMP ) ? "SSL_write()", cData @@ -627,7 +632,7 @@ METHOD inetRecv( SocketCon, cStr1, len ) CLASS TIPClient LOCAL nRet - IF ::lTLS + IF ::lSSL IF ::lHasSSL #if defined( _SSL_DEBUG_TEMP ) ? "SSL_read()" @@ -651,7 +656,7 @@ METHOD inetRecvLine( SocketCon, nRet, size ) CLASS TIPClient LOCAL cRet - IF ::lTLS + IF ::lSSL IF ::lHasSSL nRet := hb_SSL_read_line( ::ssl, @cRet, size, ::nConnTimeout ) #if defined( _SSL_DEBUG_TEMP ) @@ -679,7 +684,7 @@ METHOD inetRecvAll( SocketCon, cRet, size ) CLASS TIPClient LOCAL nRet - IF ::lTLS + IF ::lSSL IF ::lHasSSL nRet := hb_SSL_read_all( ::ssl, @cRet, size, ::nConnTimeout ) #if defined( _SSL_DEBUG_TEMP ) @@ -707,7 +712,7 @@ METHOD inetErrorCode( SocketCon ) CLASS TIPClient LOCAL nRet - IF ::lTLS + IF ::lSSL IF ::lHasSSL nRet := iif( ::nSSLError == 0, 0, SSL_get_error( ::ssl, ::nSSLError ) ) ELSE @@ -732,7 +737,7 @@ METHOD inetErrorDesc( SocketCon ) CLASS TIPClient hb_default( @SocketCon, ::SocketCon ) IF ! Empty( SocketCon ) - IF ::lTLS + IF ::lSSL IF ::lHasSSL IF ::nSSLError != 0 cMsg := ERR_error_string( SSL_get_error( ::ssl, ::nSSLError ) ) @@ -762,10 +767,8 @@ METHOD inetConnect( cServer, nPort, SocketCon ) CLASS TIPClient ::InetRcvBufSize( SocketCon, ::nDefaultRcvBuffSize ) ENDIF - IF ::lHasSSL .AND. ::lTLS - SSL_set_mode( ::ssl, HB_SSL_MODE_AUTO_RETRY ) - SSL_set_fd( ::ssl, hb_inetFD( SocketCon ) ) - SSL_connect( ::ssl ) + IF ::lHasSSL .AND. ::lSSL + ActivateSSL(Self) /* TODO: Add error handling */ ENDIF @@ -853,3 +856,16 @@ METHOD SetProxy( cProxyHost, nProxyPort, cProxyUser, cProxyPassword ) CLASS TIPC FUNCTION tip_SSL() RETURN hb_IsFunction( "__HBEXTERN__HBSSL__" ) + +FUNCTION ActivateSSL(Self) +LOCAL SocketCon + + Hb_Default(@SocketCon, ::SocketCon ) + + SSL_set_mode( ::ssl, HB_SSL_MODE_AUTO_RETRY ) + SSL_set_fd( ::ssl, hb_inetFD( SocketCon ) ) + SSL_connect( ::ssl ) + + /* TODO: Add error handling */ + + RETURN .T. \ No newline at end of file diff --git a/contrib/hbtip/sendmail.prg b/contrib/hbtip/sendmail.prg index fb80762041..800d007731 100644 --- a/contrib/hbtip/sendmail.prg +++ b/contrib/hbtip/sendmail.prg @@ -4,6 +4,7 @@ * * Copyright 2007 Luiz Rafael Culik Guimaraes and Patrick Mast * Copyright 2009 Viktor Szakats (vszakats.net/harbour) (SSL support) + * Copyright 2015 Jean Lefebvre (TLS support) * www - http://www.xharbour.org * * This program is free software; you can redistribute it and/or modify @@ -52,7 +53,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; aFiles, cUser, cPass, cPopServer, nPriority, lRead, ; xTrace, lPopAuth, lNoAuth, nTimeOut, cReplyTo, ; - lTLS, cSMTPPass, cCharset, cEncoding, cClientHost ) + lSSL, cSMTPPass, cCharset, cEncoding, cClientHost ) /* cServer -> Required. IP or domain name of the mail server nPort -> Optional. Port used my email server @@ -74,6 +75,10 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; lNoAuth -> Optional. Disable Autentication methods nTimeOut -> Optional. Number os ms to wait default 10000 (10s) cReplyTo -> Optional. + lSSl -> Optional. Need SSL at connect time (TLS need this param set to False) + cSMTPPass -> Optional. + cCharset -> Optional. + cEncoding -> Optional. cClientHost-> Optional. Domain name of the SMTP client in the format smtp.example.com OR client IP surrounded by brackets as in [200.100.100.5] Note: This parameter is optional for backwards compatibility, but should be provided to comply with RFC 2812. */ @@ -90,8 +95,8 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; LOCAL lConnectPlain := .F. LOCAL lReturn := .T. - LOCAL lAuthLogin := .F. - LOCAL lAuthPlain := .F. + //LOCAL lAuthLogin := .F. + //LOCAL lAuthPlain := .F. LOCAL lAuthTLS := .F. LOCAL lConnect := .T. LOCAL oPop @@ -111,7 +116,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; hb_default( @lPopAuth, .T. ) hb_default( @lNoAuth, .F. ) hb_default( @nTimeOut, 10000 ) - hb_default( @lTLS, .F. ) + hb_default( @lSSL, .F. ) hb_default( @cSMTPPass, cPass ) // cTo @@ -181,7 +186,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; IF cPopServer != NIL .AND. lPopAuth BEGIN SEQUENCE - oUrl1 := TUrl():New( iif( lTLS, "pop3s://", "pop://" ) + cUser + ":" + cPass + "@" + cPopServer + "/" ) + oUrl1 := TUrl():New( iif( lSSL, "pop3s://", "pop://" ) + cUser + ":" + cPass + "@" + cPopServer + "/" ) oUrl1:cUserid := StrTran( cUser, "&at;", "@" ) oPop := TIPClientPOP():New( oUrl1, xTrace ) IF oPop:Open() @@ -199,7 +204,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; ENDIF BEGIN SEQUENCE - oUrl := TUrl():New( iif( lTLS, "smtps://", "smtp://" ) + cUser + iif( Empty( cSMTPPass ), "", ":" + cSMTPPass ) + "@" + cServer ) + oUrl := TUrl():New( iif( lSSL, "smtps://", "smtp://" ) + cUser + iif( Empty( cSMTPPass ), "", ":" + cSMTPPass ) + "@" + cServer ) RECOVER lReturn := .F. END SEQUENCE @@ -227,26 +232,12 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; IF ! lNoAuth - IF oInMail:OpenSecure() + IF oInMail:OpenSecure( NIL, lSSL) - DO WHILE .T. - IF ! oInMail:GetOk() - EXIT - ENDIF - IF oInMail:cReply == NIL - EXIT - ELSEIF "LOGIN" $ oInMail:cReply - lAuthLogin := .T. - ELSEIF "PLAIN" $ oInMail:cReply - lAuthPlain := .T. - ELSEIF oInMail:HasSSL() .AND. "STARTTLS" $ oInMail:cReply - lAuthTLS := .T. - ELSEIF Left( oInMail:cReply, 4 ) == "250 " - EXIT - ENDIF - ENDDO + lAuthTls := oInMail:lTLS + + IF oInMail:lAuthLogin - IF lAuthLogin IF ! oInMail:Auth( cUser, cSMTPPass ) lConnect := .F. ELSE @@ -254,7 +245,7 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; ENDIF ENDIF - IF lAuthPlain .AND. ! lConnect + IF oInMail:lAuthPlain .AND. ! lConnect IF ! oInMail:AuthPlain( cUser, cSMTPPass ) lConnect := .F. ENDIF @@ -290,15 +281,15 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; ENDIF DO WHILE .T. - IF Left( oInMail:cReply, 4 ) == "250 " - EXIT - ENDIF IF ! oInMail:GetOk() EXIT ENDIF IF oInMail:cReply == NIL EXIT ENDIF + IF Left( oInMail:cReply, 4 ) == "250 " + EXIT + ENDIF ENDDO ENDIF diff --git a/contrib/hbtip/smtpcli.prg b/contrib/hbtip/smtpcli.prg index 7b462d267b..743a66e54d 100644 --- a/contrib/hbtip/smtpcli.prg +++ b/contrib/hbtip/smtpcli.prg @@ -4,6 +4,7 @@ * * Copyright 2003 Giancarlo Niccolai * Copyright 2009 Viktor Szakats (vszakats.net/harbour) (SSL support) + * Copyright 2015 Jean Lefebvre (TLS support) * www - http://harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -49,6 +50,8 @@ /* 2007-04-12, Hannes Ziegler Added method :sendMail() + 2015-01-29, Jean Lefebvre + Added METHOD StartTLS() */ #include "hbclass.ch" @@ -57,8 +60,12 @@ CREATE CLASS TIPClientSMTP FROM TIPClient + VAR lAuthLOGIN INIT .F. + VAR lAuthPLAIN INIT .F. + VAR lTLS INIT .F. + METHOD New( oUrl, xTrace, oCredentials, cClientHost ) - METHOD Open( cUrl, lTLS ) + METHOD Open( cUrl, lSSL ) METHOD Close() METHOD Write( cData, nLen, bCommit ) METHOD Mail( cFrom ) @@ -70,10 +77,12 @@ CREATE CLASS TIPClientSMTP FROM TIPClient METHOD SendMail( oTIpMail ) /* Methods for smtp server that require login */ - METHOD OpenSecure( cUrl, lTLS ) + METHOD OpenSecure( cUrl, lSSL ) METHOD Auth( cUser, cPass ) // Auth by login method METHOD AuthPlain( cUser, cPass ) // Auth by plain method METHOD ServerSuportSecure( lAuthPlain, lAuthLogin ) + METHOD StartTLS() + METHOD DetectSecurity() HIDDEN: @@ -93,7 +102,7 @@ METHOD New( oUrl, xTrace, oCredentials, cClientHost ) CLASS TIPClientSMTP RETURN Self -METHOD Open( cUrl, lTLS ) CLASS TIPClientSMTP +METHOD Open( cUrl, lSSL ) CLASS TIPClientSMTP IF ! ::super:Open( cUrl ) RETURN .F. @@ -103,20 +112,20 @@ METHOD Open( cUrl, lTLS ) CLASS TIPClientSMTP RETURN .F. ENDIF - hb_default( @lTLS, .F. ) + hb_default( @lSSL, .F. ) - IF lTLS - ::inetSendAll( ::SocketCon, "STARTTLS" + ::cCRLF ) - IF ::GetOk() - ::EnableTLS( .T. ) - ENDIF + IF lSSL + ::EnableSSL( .T. ) + ::lAuthLogin := .T. + ::lAuthPLAIN := .T. ENDIF ::inetSendAll( ::SocketCon, "HELO " + iif( Empty( ::cClientHost ), "TIPClientSMTP", ::cClientHost ) + ::cCRLF ) RETURN ::GetOk() -METHOD OpenSecure( cUrl, lTLS ) CLASS TIPClientSMTP +METHOD OpenSecure( cUrl, lSSL ) CLASS TIPClientSMTP +Local lok IF ! ::super:Open( cUrl ) RETURN .F. @@ -126,18 +135,28 @@ METHOD OpenSecure( cUrl, lTLS ) CLASS TIPClientSMTP RETURN .F. ENDIF - hb_default( @lTLS, .F. ) - - IF lTLS - ::inetSendAll( ::SocketCon, "STARTTLS" + ::cCRLF ) - IF ::GetOk() - ::EnableTLS( .T. ) - ENDIF + hb_default( @lSSL, .F. ) + + IF lSSL + ::EnableSSL( .T. ) + ::lAuthLogin := .T. + ::lAuthPLAIN := .T. ENDIF ::inetSendAll( ::SocketCon, "EHLO " + iif( Empty( ::cClientHost ), "TIPClientSMTP", ::cClientHost ) + ::cCRLF ) - RETURN ::GetOk() + lok := ::DetectSecurity() + + IF ! lSSL + if lok + lok := ::StartTLS() + endif + ENDIF + + RETURN lOk + + + METHOD GetOk() CLASS TIPClientSMTP @@ -263,6 +282,47 @@ METHOD ServerSuportSecure( /* @ */ lAuthPlain, /* @ */ lAuthLogin ) CLASS TIPCli RETURN lAuthLogin .OR. lAuthPlain +METHOD StartTLS() + ::inetSendAll( ::SocketCon, "STARTTLS" + ::cCRLF ) + if ::GetOk() + ::EnableSSL(.T.) + ActivateSSL(Self) + else + RETURN .F. + endif + + RETURN .T. + +METHOD DetectSecurity() +Local lok + + DO WHILE .T. + IF ! (lok := ::GetOk()) + EXIT + ENDIF + IF ::cReply == NIL + EXIT + ENDIF + IF "LOGIN" $ ::cReply + ::lAuthLogin := .T. + ENDIF + IF "PLAIN" $ ::cReply + ::lAuthPlain := .T. + ENDIF + IF ::HasSSL() .AND. "STARTTLS" $ ::cReply + ::lTLS := .T. + ::lAuthLogin := .T. + ::lAuthPlain := .T. + ENDIF + IF Left( ::cReply, 4 ) == "250-" + LOOP + ELSEIF Left( ::cReply, 4 ) == "250 " + EXIT + ENDIF + ENDDO + RETURN lOk + + METHOD SendMail( oTIpMail ) CLASS TIPClientSmtp LOCAL cTo diff --git a/contrib/hbtip/tests/gmail.prg b/contrib/hbtip/tests/gmail.prg index 6889822455..2943c62ab4 100644 --- a/contrib/hbtip/tests/gmail.prg +++ b/contrib/hbtip/tests/gmail.prg @@ -1,6 +1,9 @@ /* * Copyright 2009 Viktor Szakats (vszakats.net/harbour) * www - http://harbour-project.org + * + * Gmail work with ssl on port 465 and with tls on port 587 + * tls mode is fully automatic and require that ssl must be disabled at first (We will activate it on request after STARTTLS command) */ #require "hbssl" @@ -10,7 +13,7 @@ REQUEST __HBEXTERN__HBSSL__ #include "simpleio.ch" -PROCEDURE Main( cFrom, cPassword, cTo ) +PROCEDURE Main( cFrom, cPassword, cTo, cPort) IF ! tip_SSL() ? "Error: Requires SSL support" @@ -20,16 +23,17 @@ PROCEDURE Main( cFrom, cPassword, cTo ) hb_default( @cFrom , "" ) hb_default( @cPassword, "" ) hb_default( @cTo , "addressee@domain.com" ) + hb_default( @cPort , "465" ) ? hb_SendMail( ; "smtp.gmail.com", ; - 465, ; + Val(cPort), ; cFrom, ; cTo, ; NIL /* CC */, ; {} /* BCC */, ; "test: body", ; - "test: subject", ; + "test: port "+cPort, ; NIL /* attachment */, ; cFrom, ; cPassword, ; @@ -41,6 +45,7 @@ PROCEDURE Main( cFrom, cPassword, cTo ) NIL /* lNoAuth */, ; NIL /* nTimeOut */, ; NIL /* cReplyTo */, ; - .T. ) + iif(cPort=="465",.T.,.F.) /* lSSL */ ) RETURN +