[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