ssl_streamsec.pas

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

    end;
    if FPrivateKeyFile <> '' then
      FSlave.MyTLSServer.LoadPrivateKeyRingFromFile(FPrivateKeyFile, pass);
//      FSlave.MyTLSServer.PrivateKeyRing.LoadPrivateKeyFromFile(FPrivateKeyFile, pass);
    if FPrivateKey <> '' then
    begin
      st := TMemoryStream.Create;
      try
        WriteStrToStream(st, FPrivateKey);
        st.Seek(0, soFromBeginning);
        FSlave.MyTLSServer.LoadPrivateKeyRingFromStream(st, pass);
      finally
        st.free;
      end;
    end;
    if FCertificateFile <> '' then
      FSlave.MyTLSServer.LoadMyCertsFromFile(FCertificateFile);
    if FCertificate <> '' then
    begin
      st := TMemoryStream.Create;
      try
        WriteStrToStream(st, FCertificate);
        st.Seek(0, soFromBeginning);
        FSlave.MyTLSServer.LoadMyCertsFromStream(st);
      finally
        st.free;
      end;
    end;
    if FPFXfile <> '' then
      FSlave.MyTLSServer.ImportFromPFX(FPFXfile, pass);
    if server then
    begin
      FSlave.MyTLSServer.Options.BulkCipherAES128 := prPrefer;
      FSlave.MyTLSServer.Options.BulkCipherAES256 := prAllowed;
      FSlave.MyTLSServer.Options.EphemeralECDHKeySize := ecs256;
      FSlave.MyTLSServer.Options.SignatureRSA := prPrefer;
      FSlave.MyTLSServer.Options.KeyAgreementRSA := prAllowed;
      FSlave.MyTLSServer.Options.KeyAgreementECDHE := prAllowed;
      FSlave.MyTLSServer.Options.KeyAgreementDHE := prPrefer;
      FSlave.MyTLSServer.TLSSetupServer;
    end;
    Result := true;
  finally
    pass.Free;
  end;
end;

function TSSLStreamSec.DeInit: Boolean;
begin
  Result := True;
  if assigned(FSlave) then
  begin
    FSlave.Close;
    FSlave.Free;
    FSlave := nil;
  end;
  FSSLEnabled := false;
end;

function TSSLStreamSec.Prepare(server:Boolean): Boolean;
begin
  Result := false;
  DeInit;
  if Init(server) then
    Result := true
  else
    DeInit;
end;

function TSSLStreamSec.Connect: boolean;
begin
  Result := False;
  if FSocket.Socket = INVALID_SOCKET then
    Exit;
  if Prepare(false) then
  begin
    FSlave.Open;
    SSLCheck;
    if FLastError <> 0 then
      Exit;
    FSSLEnabled := True;
    Result := True;
  end;
end;

function TSSLStreamSec.Accept: boolean;
begin
  Result := False;
  if FSocket.Socket = INVALID_SOCKET then
    Exit;
  if Prepare(true) then
  begin
    FSlave.Open;
    SSLCheck;
    if FLastError <> 0 then
      Exit;
    FSSLEnabled := True;
    Result := True;
  end;
end;

function TSSLStreamSec.Shutdown: boolean;
begin
  Result := BiShutdown;
end;

function TSSLStreamSec.BiShutdown: boolean;
begin
  DeInit;
  Result := True;
end;

function TSSLStreamSec.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
var
  l: integer;
begin
  l := len;
  FSlave.SendBuf(Buffer^, l, true);
  Result := l;
  SSLCheck;
end;

function TSSLStreamSec.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
var
  l: integer;
begin
  l := Len;
  Result := FSlave.ReceiveBuf(Buffer^, l);
  SSLCheck;
end;

function TSSLStreamSec.WaitingData: Integer;
begin
  Result := 0;
  while FSlave.Connected do begin
    Result := FSlave.ReceiveLength;
    if Result > 0 then
      Break;
    Sleep(1);
  end;
end;

function TSSLStreamSec.GetSSLVersion: string;
begin
  Result := 'SSLv3 or TLSv1';
end;

function TSSLStreamSec.GetCert: PASN1Struct;
begin
  if FIsServer then
    Result := FSlave.GetClientCert
  else
    Result := FSlave.GetServerCert;
end;

function TSSLStreamSec.GetPeerSubject: string;
var
  XName: TX501Name;
  Cert: PASN1Struct;
begin
  Result := '';
  Cert := GetCert;
  if Assigned(cert) then
  begin
    ExtractSubject(Cert^,XName, false);
    Result := X501NameToStr(XName);
  end;
end;

function TSSLStreamSec.GetPeerName: string;
var
  XName: TX501Name;
  Cert: PASN1Struct;
begin
  Result := '';
  Cert := GetCert;
  if Assigned(cert) then
  begin
    ExtractSubject(Cert^,XName, false);
    Result := XName.commonName.Str;
  end;
end;

function TSSLStreamSec.GetPeerIssuer: string;
var
  XName: TX501Name;
  Cert: PASN1Struct;
begin
  Result := '';
  Cert := GetCert;
  if Assigned(cert) then
  begin
    ExtractIssuer(Cert^, XName, false);
    Result := X501NameToStr(XName);
  end;
end;

function TSSLStreamSec.GetPeerFingerprint: string;
var
  Cert: PASN1Struct;
begin
  Result := '';
  Cert := GetCert;
  if Assigned(cert) then
    Result := MD5(Cert.ContentAsOctetString);
end;

function TSSLStreamSec.GetCertInfo: string;
var
  Cert: PASN1Struct;
  l: Tstringlist;
begin
  Result := '';
  Cert := GetCert;
  if Assigned(cert) then
  begin
    l := TStringList.Create;
    try
      Asn1.RenderAsText(cert^, l, true, true, true, 2);
      Result := l.Text;
    finally
      l.free;
    end;
  end;
end;

function TSSLStreamSec.X500StrToStr(const Prefix: string;
  const Value: TX500String): string;
begin
  if Value.Str = '' then
    Result := ''
  else
    Result := '/' + Prefix + '=' + Value.Str;
end;

function TSSLStreamSec.X501NameToStr(const Value: TX501Name): string;
begin
  Result := X500StrToStr('CN',Value.commonName) +
           X500StrToStr('C',Value.countryName) +
           X500StrToStr('L',Value.localityName) +
           X500StrToStr('ST',Value.stateOrProvinceName) +
           X500StrToStr('O',Value.organizationName) +
           X500StrToStr('OU',Value.organizationalUnitName) +
           X500StrToStr('T',Value.title) +
           X500StrToStr('N',Value.name) +
           X500StrToStr('G',Value.givenName) +
           X500StrToStr('I',Value.initials) +
           X500StrToStr('SN',Value.surname) +
           X500StrToStr('GQ',Value.generationQualifier) +
           X500StrToStr('DNQ',Value.dnQualifier) +
           X500StrToStr('E',Value.emailAddress);
end;


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

initialization
  SSLImplementation := TSSLStreamSec;

finalization

end.