ssl_sbb.pas

Synapse The synchronyous socket library. File content: 1.) About Synapse 2.) Distribution pa

  if FServer then
    begin
      FElSecureServer:=TElSecureServer.Create(NIL);
      if FElSecureServer<>NIL then
        begin
          // init, ciphers
          for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
            FElSecureServer.CipherSuites[loop1]:=TRUE;
          FElSecureServer.Versions:=[sbSSL2,sbSSL3,sbTLS1];
          FElSecureServer.ClientAuthentication:=FALSE;
          FElSecureServer.OnError:=OnError;
          FElSecureServer.OnSend:=OnSend;
          FElSecureServer.OnReceive:=OnReceive;
          FElSecureServer.OnData:=OnData;
          FElSecureServer.CertStorage:=FElCertStorage;
          Result:=TRUE;
        end;
    end
  else
    // init, as client
    begin
      FElSecureClient:=TElSecureClient.Create(NIL);
      if FElSecureClient<>NIL then
        begin
          // init, ciphers
          for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
            FElSecureClient.CipherSuites[loop1]:=TRUE;
          FElSecureClient.Versions:=[sbSSL3,sbTLS1];
          FElSecureClient.OnError:=OnError;
          FElSecureClient.OnSend:=OnSend;
          FElSecureClient.OnReceive:=OnReceive;
          FElSecureClient.OnData:=OnData;
          FElSecureClient.CertStorage:=FElCertStorage;
          Result:=TRUE;
        end;
    end;
end;

function TSSLSBB.DeInit:Boolean;

begin
  Result:=TRUE;
  if FElSecureServer<>NIL then
    FreeAndNIL(FElSecureServer);
  if FElSecureClient<>NIL then
    FreeAndNIL(FElSecureClient);
  if FElX509Certificate<>NIL then
    FreeAndNIL(FElX509Certificate);
  if FElCertStorage<>NIL then
    FreeAndNIL(FElCertStorage);
  FSSLEnabled:=FALSE;
end;

function TSSLSBB.Prepare(Server:Boolean): Boolean;

begin
  Result:=FALSE;
  DeInit;
  if Init(Server) then
    Result:=TRUE
  else
    DeInit;
end;

function TSSLSBB.Connect: boolean;

var
  lResult:Integer;

begin
  Result:=FALSE;
  if FSocket.Socket=INVALID_SOCKET then
    Exit;
  if Prepare(FALSE) then
    begin
      FElSecureClient.Open;

      // wait for open or error
      while (not FElSecureClient.Active) and
        (FLastError=0) do
        begin
          // data available?
          if FRecvBuffers<>'' then
            FElSecureClient.DataAvailable
          else
            begin
              // socket recv
              lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
              if lResult=SOCKET_ERROR then
                begin
                  FLastErrorDesc:='';
                  FLastError:=WSAGetLastError;
                end
              else
                begin
                  if lResult>0 then
                    FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
                  else
                    Break;
                end;
            end;
        end;
      if FLastError<>0 then
        Exit;
      FSSLEnabled:=FElSecureClient.Active;
      Result:=FSSLEnabled;
    end;
end;

function TSSLSBB.Accept: boolean;

var
  lResult:Integer;

begin
  Result:=FALSE;
  if FSocket.Socket=INVALID_SOCKET then
    Exit;
  if Prepare(TRUE) then
    begin
      FElSecureServer.Open;

      // wait for open or error
      while (not FElSecureServer.Active) and
        (FLastError=0) do
        begin
          // data available?
          if FRecvBuffers<>'' then
            FElSecureServer.DataAvailable
          else
            begin
              // socket recv
              lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
              if lResult=SOCKET_ERROR then
                begin
                  FLastErrorDesc:='';
                  FLastError:=WSAGetLastError;
                end
              else
                begin
                  if lResult>0 then
                    FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
                  else
                    Break;
                end;
            end;
        end;
      if FLastError<>0 then
        Exit;
      FSSLEnabled:=FElSecureServer.Active;
      Result:=FSSLEnabled;
    end;
end;

function TSSLSBB.Shutdown: boolean;

begin
  Result:=BiShutdown;
end;

function TSSLSBB.BiShutdown: boolean;

begin
  DeInit;
  Result:=TRUE;
end;

function TSSLSBB.SendBuffer(Buffer: TMemory; Len: Integer): Integer;

begin
  if FServer then
    FElSecureServer.SendData(Buffer,Len)
  else
    FElSecureClient.SendData(Buffer,Len);
  Result:=Len;
end;

function TSSLSBB.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;

begin
  if Length(FRecvDecodedBuffers)<Len then
    begin
      Result:=Length(FRecvDecodedBuffers);
      Move(FRecvDecodedBuffers[1],Buffer^,Result);
      FRecvDecodedBuffers:='';
    end
  else
    begin
      Result:=Len;
      Move(FRecvDecodedBuffers[1],Buffer^,Result);
      Delete(FRecvDecodedBuffers,1,Result);
    end;
end;

function TSSLSBB.WaitingData: Integer;

var
  lResult:Integer;

begin
  // data available?
  if FRecvBuffers<>'' then
    begin
      if FServer then
        FElSecureServer.DataAvailable
      else
        FElSecureClient.DataAvailable;
    end
  else
    begin
      // socket recv
      lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
      if lResult=SOCKET_ERROR then
        begin
          FLastErrorDesc:='';
          FLastError:=WSAGetLastError;
        end
      else
        FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult);

      // data available?
      if FRecvBuffers<>'' then
        begin
          if FServer then
            FElSecureServer.DataAvailable
          else
            FElSecureClient.DataAvailable;
        end;
    end;
  Result:=Length(FRecvDecodedBuffers);
end;

function TSSLSBB.GetSSLVersion: string;

begin
  Result:='SSLv3 or TLSv1';
end;

function TSSLSBB.GetPeerSubject: string;

begin
  Result := '';
//  if FServer then
    // must return subject of the client certificate
//  else
    // must return subject of the server certificate
end;

function TSSLSBB.GetPeerName: string;

begin
  Result := '';
//  if FServer then
    // must return commonname of the client certificate
//  else
    // must return commonname of the server certificate
end;

function TSSLSBB.GetPeerIssuer: string;

begin
  Result := '';
//  if FServer then
    // must return issuer of the client certificate
//  else
    // must return issuer of the server certificate
end;

function TSSLSBB.GetPeerFingerprint: string;

begin
  Result := '';
//  if FServer then
    // must return a unique hash string of the client certificate
//  else
    // must return a unique hash string of the server certificate
end;

function TSSLSBB.GetCertInfo: string;

begin
  Result := '';
//  if FServer then
    // must return a text representation of the ASN of the client certificate
//  else
    // must return a text representation of the ASN of the server certificate
end;

{==============================================================================}

initialization
  SSLImplementation := TSSLSBB;

finalization

end.