[Lazarus] TFpHttpClient and ssl
Andrew Brunner
andrew.t.brunner at gmail.com
Tue Apr 3 23:59:14 CEST 2012
2012/4/3 Michael Van Canneyt <michael at freepascal.org>
>
> I had a cursory look. The unit is the interface to SSL. We have this
> interface already (openssl unit).
>
> I searched for aurawin socket, but could not find anything.
>
> Hi Michael. Looking at the difference is what's needed to implement a
security "layer". The missing decs/methods are essential ones.
A sockets engine would need a system like this...
PSecureInfo=^TSecureInfo;
TSecureMode=(sslServer,sslClient);
TSecureInfo=record
Mode : TSecureMode;
keyData : String;
keyLen : Integer;
certData : String;
certLen : Integer;
end;
TSSLInfo=record
Method : PSSL_METHOD;
Context : PSSL_CTX;
Handle : PSSL;
ctxSessionID : string;
ctxSessionIDLen : integer;
end;
A server thread would do this on Thread.Execute (before all your other
stuff)
var // place these anywhere even private to thread
FSSLMethod : PSSL_METHOD;
FSSLContext : PSSL_CTX;
FSSLContextID : String;
FSSLContextIDLen : Integer;
FSSLInfo :TSSLInfo // this belongs to your remote
socket class
begin
FSSLMethod:=SSLv3_server_method();
FSSLContext:=SSL_ctx_new(FSSLMethod);
SslCtxSetCipherList(FSSLContext,'DEFAULT');
SslCtxSetVerify(FSSLContext,SSL_VERIFY_NONE, nil);
SSLCTXSetMode(FSSLContext,SSL_MODE_ENABLE_PARTIAL_WRITE);
if Assigned(SSL_CTX_set_session_cache_mode) then
SSL_CTX_set_session_cache_mode(FSSLContext,SSL_SESS_CACHE_OFF);
FSSLContextID:=hRSR.Generate_SSL_SessionID;
FSSLContextIDLen:=System.Length(FSSLContextID);
EntryPoint:='TRSRManager.Execute.SSL_CTX_set_session_id_context';
try
SSL_CTX_set_session_id_context(FSSLContext, at FSSLContextID[1],FSSLContextIDLen);
except
On E:Exception do OnRSRException(EntryPoint,'Exception',E.Message);
end;
if
SslCtxUseRSAPrivateKeyASN1(FSSLContext, at FSSLInfoP^.keyData[1],FSSLInfoP^.keyLen)<>1
then begin
OnRSRException('TRSRServer.Execute.SslCtxUseRSAPrivateKeyASN1','Exception',Concat('Open
SSL Error ',IntToStr(uSSL.ERR_get_error())));
end;
if SslCtxUseCertificateASN1(FSSLContext,
FSSLInfoP^.certLen, at FSSLInfoP^.certData[1]) <>1 then begin
OnRSRException('TRSRServer.Execute.SslCtxUseCertificateASN1','Exception',Concat('Open
SSL Error ',IntToStr(uSSL.ERR_get_error())));
end;
// There are 2 strings needed that you need can be generated using the
toolkit that comes with openssl et al.
... Somwhere else...
socket=fpAccept()
FSSLInfo.Handle:=SSL_new(FSSLContext);
TaskError:=SSL_get_error(FSSLInfo.Handle, LastCall); // always inspect
ssl lib calls to empty out error "stack";
SSL_set_fd(.SSL.Handle,socket);
TaskError:=SSL_get_error(SSL.Handle, LastCall);
If you are a server socket do this...
SSL_accept(SSL.Handle);
TaskError:=SSL_get_error(SSL.Handle, LastCall);
// This will do all the socket negotiation for you!!!!
if you are a client socket do this...
SSL_connect(SSL.Handle);
TaskError:=SSL_get_error(SSL.Handle, LastCall);
// This will do all the client socket negotiaon for you!!!
If you wan to send data over SSL enabled socket just bypass fpSend and do
this
LastCall:=SSL_write(SSL.Handle, at FSendBuffer[0],iSend);
TaskError:=SSL_get_error(SSL.Handle, LastCall);
If you want to recv Data over SSL enabled socket just bypass fpRecv and do
this
LastCall:=SSL_read(SSL.Handle, at FRecvBuffer[0],iRead);
TaskError:=SSL_get_error(SSL.Handle, LastCall);
When your socket cleanup is about to happend (Socket was closed)
SSL_clear(SSL.Handle);
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20120403/fa7571aa/attachment-0003.html>
More information about the Lazarus
mailing list