fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2015-01-29 23:55 UTC+0100 Jean Lefebvre (jfl/at/mafact.com)

Browse Source 
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)
This commit is contained in:
Jean Lefebvre (Mafact)
2015-01-29 23:57:12 +01:00
parent 32b22ec738
commit 873c60d54f
5 changed files with 157 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
ChangeLog.txt
View File

@@ -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()

54
contrib/hbtip/client.prg
View File

@@ -4,6 +4,7 @@
*
* Copyright 2003 Giancarlo Niccolai <gian@niccolai.ws>
* 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.

47
contrib/hbtip/sendmail.prg
View File

@@ -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

96
contrib/hbtip/smtpcli.prg
View File

@@ -4,6 +4,7 @@
*
* Copyright 2003 Giancarlo Niccolai <gian@niccolai.ws>
* 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 <hz AT knowlexbase.com>
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

13
contrib/hbtip/tests/gmail.prg
View File

@@ -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 , "<myname@gmail.com>" )
hb_default( @cPassword, "<mypassword>" )
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