ssl_openssl.pas

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

    Exit;
  end;
  if Fctx = nil then
  begin
    SSLCheck;
    Exit;
  end
  else
  begin
    SslCtxSetCipherList(Fctx, FCiphers);
    if FVerifyCert then
      SslCtxSetVerify(FCtx, SSL_VERIFY_PEER, nil)
    else
      SslCtxSetVerify(FCtx, SSL_VERIFY_NONE, nil);
{$IFNDEF CIL}
    SslCtxSetDefaultPasswdCb(FCtx, @PasswordCallback);
    SslCtxSetDefaultPasswdCbUserdata(FCtx, self);
{$ENDIF}

    if server and (FCertificateFile = '') and (FCertificate = '')
      and (FPFXfile = '') and (FPFX = '') then
    begin
      CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
    end;

    if not SetSSLKeys then
      Exit
    else
    begin
      Fssl := nil;
      Fssl := SslNew(Fctx);
      if Fssl = nil then
      begin
        SSLCheck;
        exit;
      end;
    end;
  end;
  Result := true;
end;

function TSSLOpenSSL.DeInit: Boolean;
begin
  Result := True;
  if assigned (Fssl) then
    sslfree(Fssl);
  Fssl := nil;
  if assigned (Fctx) then
  begin
    SslCtxFree(Fctx);
    Fctx := nil;
    ErrRemoveState(0);
  end;
  FSSLEnabled := False;
end;

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

function TSSLOpenSSL.Connect: boolean;
var
  x: integer;
begin
  Result := False;
  if FSocket.Socket = INVALID_SOCKET then
    Exit;
  if Prepare(False) then
  begin
{$IFDEF CIL}
    if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
{$ELSE}
    if sslsetfd(FSsl, FSocket.Socket) < 1 then
{$ENDIF}
    begin
      SSLCheck;
      Exit;
    end;
    x := sslconnect(FSsl);
    if x < 1 then
    begin
      SSLcheck;
      Exit;
    end;
  if FverifyCert then
    if GetVerifyCert <> 0 then
      Exit;
    FSSLEnabled := True;
    Result := True;
  end;
end;

function TSSLOpenSSL.Accept: boolean;
var
  x: integer;
begin
  Result := False;
  if FSocket.Socket = INVALID_SOCKET then
    Exit;
  if Prepare(True) then
  begin
{$IFDEF CIL}
    if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
{$ELSE}
    if sslsetfd(FSsl, FSocket.Socket) < 1 then
{$ENDIF}
    begin
      SSLCheck;
      Exit;
    end;
    x := sslAccept(FSsl);
    if x < 1 then
    begin
      SSLcheck;
      Exit;
    end;
    FSSLEnabled := True;
    Result := True;
  end;
end;

function TSSLOpenSSL.Shutdown: boolean;
begin
  if assigned(FSsl) then
    sslshutdown(FSsl);
  DeInit;
  Result := True;
end;

function TSSLOpenSSL.BiShutdown: boolean;
var
  x: integer;
begin
  if assigned(FSsl) then
  begin
    x := sslshutdown(FSsl);
    if x = 0 then
    begin
      Synsock.Shutdown(FSocket.Socket, 1);
      sslshutdown(FSsl);
    end;
  end;
  DeInit;
  Result := True;
end;

function TSSLOpenSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
var
  err: integer;
{$IFDEF CIL}
  s: ansistring;
{$ENDIF}
begin
  FLastError := 0;
  FLastErrorDesc := '';
  repeat
{$IFDEF CIL}
    s := StringOf(Buffer);
    Result := SslWrite(FSsl, s, Len);
{$ELSE}
    Result := SslWrite(FSsl, Buffer , Len);
{$ENDIF}
    err := SslGetError(FSsl, Result);
  until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
  if err = SSL_ERROR_ZERO_RETURN then
    Result := 0
  else
    if (err <> 0) then
      FLastError := err;
end;

function TSSLOpenSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
var
  err: integer;
{$IFDEF CIL}
  sb: stringbuilder;
  s: ansistring;
{$ENDIF}
begin
  FLastError := 0;
  FLastErrorDesc := '';
  repeat
{$IFDEF CIL}
    sb := StringBuilder.Create(Len);
    Result := SslRead(FSsl, sb, Len);
    if Result > 0 then
    begin
      sb.Length := Result;
      s := sb.ToString;
      System.Array.Copy(BytesOf(s), Buffer, length(s));
    end;
{$ELSE}
    Result := SslRead(FSsl, Buffer , Len);
{$ENDIF}
    err := SslGetError(FSsl, Result);
  until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
  if err = SSL_ERROR_ZERO_RETURN then
    Result := 0
  else
    if (err <> 0) then
      FLastError := err;
end;

function TSSLOpenSSL.WaitingData: Integer;
begin
  Result := sslpending(Fssl);
end;

function TSSLOpenSSL.GetSSLVersion: string;
begin
  if not assigned(FSsl) then
    Result := ''
  else
    Result := SSlGetVersion(FSsl);
end;

function TSSLOpenSSL.GetPeerSubject: string;
var
  cert: PX509;
  s: string;
{$IFDEF CIL}
  sb: StringBuilder;
{$ENDIF}
begin
  if not assigned(FSsl) then
  begin
    Result := '';
    Exit;
  end;
  cert := SSLGetPeerCertificate(Fssl);
  if not assigned(cert) then
  begin
    Result := '';
    Exit;
  end;
{$IFDEF CIL}
  sb := StringBuilder.Create(4096);
  Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096);
{$ELSE}
  setlength(s, 4096);
  Result := X509NameOneline(X509GetSubjectName(cert), s, Length(s));
{$ENDIF}
  X509Free(cert);
end;

function TSSLOpenSSL.GetPeerName: string;
var
  s: string;
begin
  s := GetPeerSubject;
  s := SeparateRight(s, '/CN=');
  Result := Trim(SeparateLeft(s, '/'));
end;

function TSSLOpenSSL.GetPeerIssuer: string;
var
  cert: PX509;
  s: string;
{$IFDEF CIL}
  sb: StringBuilder;
{$ENDIF}
begin
  if not assigned(FSsl) then
  begin
    Result := '';
    Exit;
  end;
  cert := SSLGetPeerCertificate(Fssl);
  if not assigned(cert) then
  begin
    Result := '';
    Exit;
  end;
{$IFDEF CIL}
  sb := StringBuilder.Create(4096);
  Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096);
{$ELSE}
  setlength(s, 4096);
  Result := X509NameOneline(X509GetIssuerName(cert), s, Length(s));
{$ENDIF}
  X509Free(cert);
end;

function TSSLOpenSSL.GetPeerFingerprint: string;
var
  cert: PX509;
  x: integer;
{$IFDEF CIL}
  sb: StringBuilder;
{$ENDIF}
begin
  if not assigned(FSsl) then
  begin
    Result := '';
    Exit;
  end;
  cert := SSLGetPeerCertificate(Fssl);
  if not assigned(cert) then
  begin
    Result := '';
    Exit;
  end;
{$IFDEF CIL}
  sb := StringBuilder.Create(EVP_MAX_MD_SIZE);
  X509Digest(cert, EvpGetDigestByName('MD5'), sb, x);
  sb.Length := x;
  Result := sb.ToString;
{$ELSE}
  setlength(Result, EVP_MAX_MD_SIZE);
  X509Digest(cert, EvpGetDigestByName('MD5'), Result, x);
  SetLength(Result, x);
{$ENDIF}
  X509Free(cert);
end;

function TSSLOpenSSL.GetCertInfo: string;
var
  cert: PX509;
  x, y: integer;
  b: PBIO;
  s: AnsiString;
{$IFDEF CIL}
  sb: stringbuilder;
{$ENDIF}
begin
  if not assigned(FSsl) then
  begin
    Result := '';
    Exit;
  end;
  cert := SSLGetPeerCertificate(Fssl);
  if not assigned(cert) then
  begin
    Result := '';
    Exit;
  end;
  b := BioNew(BioSMem);
  try
    X509Print(b, cert);
    x := bioctrlpending(b);
{$IFDEF CIL}
    sb := StringBuilder.Create(x);
    y := bioread(b, sb, x);
    if y > 0 then
    begin
      sb.Length := y;
      s := sb.ToString;
    end;
{$ELSE}
    setlength(s,x);
    y := bioread(b,s,x);
    if y > 0 then
      setlength(s, y);
{$ENDIF}
    Result := ReplaceString(s, LF, CRLF);
  finally
    BioFreeAll(b);
  end;
end;

function TSSLOpenSSL.GetCipherName: string;
begin
  if not assigned(FSsl) then
    Result := ''
  else
    Result := SslCipherGetName(SslGetCurrentCipher(FSsl));
end;

function TSSLOpenSSL.GetCipherBits: integer;
var
  x: integer;
begin
  if not assigned(FSsl) then
    Result := 0
  else
    Result := SSLCipherGetBits(SslGetCurrentCipher(FSsl), x);
end;

function TSSLOpenSSL.GetCipherAlgBits: integer;
begin
  if not assigned(FSsl) then
    Result := 0
  else
    SSLCipherGetBits(SslGetCurrentCipher(FSsl), Result);
end;

function TSSLOpenSSL.GetVerifyCert: integer;
begin
  if not assigned(FSsl) then
    Result := 1
  else
    Result := SslGetVerifyResult(FSsl);
end;

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

initialization
  if InitSSLInterface then
    SSLImplementation := TSSLOpenSSL;

end.