* Rework SSL handling to be pluggable, add HTTPS support to fphttpserver

git-svn-id: trunk@40769 -

.gitattributes

@@ -2604,6 +2604,7 @@ packages/fcl-net/src/netware/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/netwlibc/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/os2/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/resolve.pp svneol=native#text/plain
+packages/fcl-net/src/sslbase.pp svneol=native#text/plain
 packages/fcl-net/src/sslsockets.pp svneol=native#text/plain
 packages/fcl-net/src/ssockets.pp svneol=native#text/plain
 packages/fcl-net/src/unix/resolve.inc svneol=native#text/plain
@@ -6711,6 +6712,7 @@ packages/openssl/examples/test1.pas svneol=native#text/plain
 packages/openssl/fpmake.pp svneol=native#text/plain
 packages/openssl/src/fpopenssl.pp svneol=native#text/plain
 packages/openssl/src/openssl.pas svneol=native#text/plain
+packages/openssl/src/opensslsockets.pp svneol=native#text/plain
 packages/oracle/Makefile svneol=native#text/plain
 packages/oracle/Makefile.fpc svneol=native#text/plain
 packages/oracle/Makefile.fpc.fpcmake svneol=native#text/plain

packages/fcl-net/fpmake.pp

@@ -19,7 +19,6 @@ begin
 {$endif ALLPACKAGES}
     P.Version:='3.3.1';
     P.Dependencies.Add('fcl-base');
-    P.Dependencies.Add('openssl',AllUnixOSes+AllWindowsOSes);
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-passrc');
     P.Dependencies.Add('fcl-async',[linux,freebsd,netbsd,openbsd,dragonfly]);
@@ -44,6 +43,7 @@ begin
 
     // IP and Sockets
     T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes);
+    T:=P.Targets.AddUnit('sslbase.pp');
     T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+AllAmigaLikeOSes+[OS2,EMX]);
       with T.Dependencies do
         begin

packages/fcl-net/src/sslbase.pp

@@ -0,0 +1,242 @@
+unit sslbase;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+Type
+  TSSLType = (stAny,stSSLv2,stSSLv3,stTLSv1,stTLSv1_1,stTLSv1_2);
+
+  { TSSLData }
+
+  TSSLData = Class(TPersistent)
+  private
+    FFileName: String;
+    FValue: TBytes;
+  Public
+    Function Empty : Boolean;
+    Procedure Assign(Source : TPersistent);override;
+    Property FileName : String Read FFileName Write FFileName;
+    Property Value: TBytes Read FValue Write FValue;
+  end;
+
+Const
+  SSLDataCount = 4; // 0 based.
+  StrDataCount = 2; // 0 based.
+
+Type
+  { TSSLSocketHandler }
+
+  { TCertificateData }
+
+  TCertificateData = Class(TPersistent)
+  Private
+    FStrData : Array[0..StrDataCount] of string;
+    FCertData : Array[0..SSLDataCount] of TSSLData;
+    function GetSSLData(AIndex: Integer): TSSLData;
+    procedure SetSSLData(AIndex: Integer; AValue: TSSLData);
+    function GetString(AIndex: Integer): String;
+    procedure SetString(AIndex: Integer; AValue: String);
+  Public
+    constructor Create;
+    Destructor Destroy; override;
+    Procedure Assign(Source : TPersistent); override;
+    Function NeedCertificateData : Boolean;
+  Published
+    property KeyPassword: string Index 0 read GetString write SetString;
+    property CipherList: string Index 1 read GetString write SetString;
+    Property HostName : String Index 2 read GetString write SetString;
+    property Certificate : TSSLData Index 0 Read GetSSLData Write SetSSLData;
+    property TrustedCertificate : TSSLData Index 1 Read GetSSLData Write SetSSLData;
+    property PrivateKey : TSSLData Index 2 Read GetSSLData Write SetSSLData;
+    property PFX: TSSLData Index 3 Read GetSSLData Write SetSSLData;
+    property CertCA: TSSLData Index 4 Read GetSSLData Write SetSSLData;
+  end;
+
+    { TX509Certificate }
+  TCertAndKey = Record
+    Certificate : TBytes;
+    PrivateKey : TBytes;
+  end;
+
+  TX509Certificate = Class (TObject)
+  private
+    FCommonName: string;
+    FCountry: String;
+    FHostName: string;
+    FKeySize: Integer;
+    FOrganization: String;
+    FSerial: Integer;
+    FValidFrom: TDateTime;
+    FValidTo: TDateTime;
+    FVersion: Integer;
+    function GetKeySize: Integer;
+    function GetValidFrom: TDateTime;
+    function GetValidTo: TDateTime;
+    function GetVersion: Integer;
+  Protected
+    Function GetRealSerial : Integer;
+  Public
+    Function CreateCertificateAndKey : TCertAndKey; virtual; abstract;
+    Procedure CreateCertificateAndKey(Var aCertificate,aKey : TBytes);
+    Property Country : String Read FCountry Write FCountry;
+    Property HostName : string Read FHostName Write FHostName;
+    Property CommonName : string Read FCommonName Write FCommonName;
+    Property Organization : String Read FOrganization Write FOrganization;
+    Property KeySize : Integer Read GetKeySize Write FKeySize;
+    // Valid from. Default today -1;
+    Property ValidFrom : TDateTime Read GetValidFrom Write FValidFrom;
+    // Valid To. Default today + 31;
+    Property ValidTo : TDateTime Read GetValidTo Write FValidTo;
+    // Version Default 1.
+    Property Version : Integer Read GetVersion Write FVersion;
+    // Serial. If zero, then a serial is generated.
+    Property Serial : Integer Read FSerial Write FSerial;
+
+  end;
+
+implementation
+
+{ TSSLData }
+
+Function TSSLData.Empty: Boolean;
+begin
+  Result:=(Length(Value)=0) and (FileName='');
+end;
+
+Procedure TSSLData.Assign(Source: TPersistent);
+
+begin
+  if Source is TSSLData then
+   With TSSLData(Source) do
+    begin
+    Self.FValue:=FValue;
+    Self.FFileName:=FFileName;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TCertificateData }
+
+function TCertificateData.GetSSLData(AIndex: Integer): TSSLData;
+begin
+  Result:=FCertData[AIndex];
+end;
+
+procedure TCertificateData.SetSSLData(AIndex: Integer; AValue: TSSLData);
+begin
+  FCertData[AIndex].Assign(AValue);
+end;
+
+function TCertificateData.GetString(AIndex: Integer): String;
+begin
+  Result:=FStrData[AIndex];
+  if (AIndex=2) and (result='') then
+    Result:='localhost';
+end;
+
+procedure TCertificateData.SetString(AIndex: Integer; AValue: String);
+begin
+  FStrData[AIndex]:=aValue;
+end;
+
+constructor TCertificateData.Create;
+
+Var
+  I : Integer;
+
+begin
+  CipherList:='DEFAULT';
+  HostName:='localhost';
+  For I:=0 to SSLDataCount do
+    FCertData[i]:=TSSLData.Create;
+end;
+
+destructor TCertificateData.Destroy;
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to SSLDataCount do
+    FreeAndNil(FCertData[i]);
+  inherited Destroy;
+end;
+
+procedure TCertificateData.Assign(Source: TPersistent);
+
+Var
+  CD : TCertificateData;
+  I : Integer;
+
+begin
+  if Source is TCertificateData then
+    begin
+    CD:=Source as TCertificateData;
+    For I:=0 to StrDataCount do
+      FStrData[i]:=CD.FStrData[i];
+    For I:=0 to SSLDataCount do
+      FCertData[i].Assign(CD.FCertData[i])
+    end
+  else
+    inherited Assign(Source);
+end;
+
+function TCertificateData.NeedCertificateData: Boolean;
+begin
+  Result:=Certificate.Empty and PFX.Empty;
+end;
+
+function TX509Certificate.GetKeySize: Integer;
+begin
+  Result:=FKeySize;
+  if Result=0 then
+    Result:=1024;
+end;
+
+function TX509Certificate.GetValidFrom: TDateTime;
+begin
+  Result:=FValidFrom;
+  If Result=0 then
+    Result:=Date-1;
+end;
+
+function TX509Certificate.GetValidTo: TDateTime;
+begin
+  Result:=FValidTo;
+  If Result=0 then
+    Result:=Date+31;
+end;
+
+
+function TX509Certificate.GetVersion: Integer;
+begin
+  Result:=FVersion;
+  if FVersion=0 then
+    FVersion:=1;
+end;
+
+function TX509Certificate.GetRealSerial: Integer;
+begin
+  Result:=FSerial;
+  if Result=0 then
+    Result:=10; // MinutesBetween(Now,EncodeDate(2019,1,1));
+end;
+
+procedure TX509Certificate.CreateCertificateAndKey(var aCertificate, aKey: TBytes);
+
+Var
+  CK : TCertAndKey;
+
+begin
+  CK:=CreateCertificateAndKey;
+  aCertificate:=CK.Certificate;
+  aKey:=CK.PrivateKey;
+end;
+
+end.
+

packages/fcl-net/src/sslsockets.pp

@@ -19,444 +19,203 @@ unit sslsockets;
 interface
 
 uses
-  Classes, SysUtils, sockets, ssockets, openssl, fpopenssl;
+  Classes, SysUtils, sockets, ssockets, sslbase;
 
 Const
-  SSLDataCount = 4; // 0 based.
+  SUseCertData = 'use CertificateData instead';
 
 Type
+  ESSLSocketError = Class(ESocketError);
+  TSSLSocketHandler = class;
   TVerifyCertificateEvent = Procedure(Sender : TObject; Allow : Boolean) of object;
+  TSSLSocketHandlerClass = class of TSSLSocketHandler;
+
   { TSSLSocketHandler }
 
   TSSLSocketHandler = class(TSocketHandler)
   private
-    FRemoteHostName: String;
-    FSSLLastErrorString: string;
-    FCipherList: string;
+    FCertGenerator: TX509Certificate;
+    FCertificateData: TCertificateData;
     FVerifyPeerCert: Boolean;
     FOnVerifyCertificate: TVerifyCertificateEvent;
     FSSLType: TSSLType;
-    FKeyPassword: string;
-    FUsername: string;
-    FPassword: string;
-    FCertData : Array[0..4] of TSSLData;
-    FSSL: TSSL;
-    FCTX : TSSLContext;
     FSSLActive : Boolean;
     FSendHostAsSNI : Boolean;
     function GetSSLData(AIndex: Integer): TSSLData;
+    function GetString(AIndex: Integer): string;
+    procedure SetCertificateData(AValue: TCertificateData);
     procedure SetSSLData(AIndex: Integer; AValue: TSSLData);
-    procedure SetSSLLastErrorString(AValue: string);
+    procedure SetString(AIndex: Integer; AValue: string);
+  Private
+    Class Var FDefaultHandlerClass : TSSLSocketHandlerClass;
   protected
-    Function FetchErrorInfo: Boolean;
-    function CheckSSL(SSLResult: Integer): Boolean;
-    function CheckSSL(SSLResult: Pointer): Boolean;
-    function InitContext(NeedCertificate: Boolean): Boolean; virtual;
-    function DoneContext: Boolean; virtual;
-    function InitSslKeys: boolean;virtual;
-    function DoVerifyCert:boolean;
+    Procedure SetSSLActive(aValue : Boolean);
+    function DoVerifyCert: boolean;
   public
     constructor Create; override;
     Destructor Destroy; override;
+    // Class factory methods
+    Class Procedure SetDefaultHandlerClass(aClass : TSSLSocketHandlerClass);
+    Class Function GetDefaultHandlerClass : TSSLSocketHandlerClass;
+    Class Function GetDefaultHandler : TSSLSocketHandler;
     // Socket methods
-    function Connect : Boolean; override;
-    function Close : Boolean; override;
-    function Accept : Boolean; override;
-    function Shutdown(BiDirectional : Boolean): boolean; override;
-    function Send(Const Buffer; Count: Integer): Integer; override;
-    function Recv(Const Buffer; Count: Integer): Integer; override;
-    function BytesAvailable: Integer; override;
-    Function SSLActive: Boolean;
-    function CreateSelfSignedCertificate(Const AHostName: string): Boolean; virtual;
-    // Result of last CheckSSL call.
-    Function SSLLastError: integer;
-    property SSLLastErrorString: string read FSSLLastErrorString write SetSSLLastErrorString;
+    Function CreateCertificateData : TCertificateData; virtual;
+    Function CreateCertGenerator : TX509Certificate; virtual;
+    function CreateSelfSignedCertificate: Boolean; virtual;
+    Property CertGenerator : TX509Certificate Read FCertGenerator;
+    Property SSLActive: Boolean read FSSLActive;
   published
     property SSLType: TSSLType read FSSLType write FSSLType;
-    {:Password for decrypting of encoded certificate or key.}
-    property Username: string read FUsername write FUsername;
-    property Password: string read FPassword write FPassword;
-    property KeyPassword: string read FKeyPassword write FKeyPassword;
-    property CipherList: string read FCipherList write FCipherList;
-    property Certificate : TSSLData Index 0 Read GetSSLData Write SetSSLData;
-    property TrustedCertificate : TSSLData Index 1 Read GetSSLData Write SetSSLData;
-    property PrivateKey : TSSLData Index 2 Read GetSSLData Write SetSSLData;
-    property PFX: TSSLData Index 3 Read GetSSLData Write SetSSLData;
-    property CertCA: TSSLData Index 4 Read GetSSLData Write SetSSLData;
     property VerifyPeerCert: Boolean read FVerifyPeerCert Write FVerifyPeerCert;
     Property SendHostAsSNI : Boolean Read FSendHostAsSNI Write FSendHostAsSNI;
+    Property CertificateData : TCertificateData Read FCertificateData Write SetCertificateData;
+    // Deprecated, use CertificateData instead.
+    property KeyPassword: string Index 0 read GetString write SetString; deprecated 'use CertificateData instead';
+    property CipherList: string Index 1 read GetString write SetString; deprecated 'use CertificateData instead';
     // In case a certificate must be generated as server, this is the hostname that will be used.
-    property RemoteHostName : String Read FRemoteHostName Write FRemoteHostName;
+    property RemoteHostName : String Index 2 read GetString write SetString; deprecated 'use CertificateData instead';
+    property Certificate : TSSLData Index 0 Read GetSSLData Write SetSSLData; deprecated 'use CertificateData instead';
+    property TrustedCertificate : TSSLData Index 1 Read GetSSLData Write SetSSLData;deprecated 'use CertificateData instead';
+    property PrivateKey : TSSLData Index 2 Read GetSSLData Write SetSSLData;deprecated 'use CertificateData instead';
+    property PFX: TSSLData Index 3 Read GetSSLData Write SetSSLData;deprecated 'use CertificateData instead';
+    property CertCA: TSSLData Index 4 Read GetSSLData Write SetSSLData;deprecated 'use CertificateData instead';
     property OnVerifyCertificate: TVerifyCertificateEvent read FOnVerifyCertificate write FOnVerifyCertificate;
   end;
 
 
+
 implementation
 
-{ TSocketHandler }
 Resourcestring
-  SErrNoLibraryInit = 'Could not initialize OpenSSL library';
-
-Procedure MaybeInitSSLInterface;
-
-begin
-  if not IsSSLloaded then
-    if not InitSSLInterface then
-      Raise EInOutError.Create(SErrNoLibraryInit);
-end;
-
+  SErrNoSSLSupport =
+    'No SSL Socket support compiled in.'+sLineBreak+
+    'Please include opensslsockets unit in program and recompile it.';
+  SErrNoX509Certificate =
+    'Cannot create a X509 certificate without SLL support';
 
 { TSSLSocketHandler }
 
-function TSSLSocketHandler.GetSSLData(AIndex: Integer): TSSLData;
-begin
-  Result:=FCertData[AIndex];
-end;
-
-procedure TSSLSocketHandler.SetSSLData(AIndex: Integer; AValue: TSSLData);
-begin
-  FCertData[AIndex].Assign(AValue);
-end;
-
-procedure TSSLSocketHandler.SetSSLLastErrorString(AValue: string);
-begin
-  if FSSLLastErrorString=AValue then Exit;
-  FSSLLastErrorString:=AValue;
-end;
-
-
-function TSSLSocketHandler.DoVerifyCert: boolean;
-begin
-  Result:=True;
-  If Assigned(OnVerifyCertificate) then
-    OnVerifyCertificate(Self,Result);
-end;
-
-constructor TSSLSocketHandler.Create;
-
-Var
-  I : Integer;
-begin
-  inherited Create;
-  FSendHostAsSNI:=True;
-  MaybeInitSSLInterface;
-  FCipherList:='DEFAULT';
-  For I:=0 to SSLDataCount do
-    FCertData[i]:=TSSLData.Create;
-end;
-
-Destructor TSSLSocketHandler.Destroy;
-
-Var
-  I : Integer;
 
+function TSSLSocketHandler.GetSSLData(AIndex: Integer): TSSLData;
 begin
-  FreeAndNil(FSSL);
-  FreeAndNil(FCTX);
-  inherited Destroy;
-  For I:=0 to SSLDataCount do
-    FreeAndNil(FCertData[i]);
+  Case aIndex of
+    0 : Result:=FCertificateData.Certificate;
+    1 : Result:=FCertificateData.TrustedCertificate;
+    2 : Result:=FCertificateData.PrivateKey;
+    3 : Result:=FCertificateData.PFX;
+    4 : Result:=FCertificateData.CertCA;
+  end;
 end;
 
-function TSSLSocketHandler.CreateSelfSignedCertificate(Const AHostName: string): Boolean;
-
-Const
-  OneDay = 60*60*24;
-  SixtyDays = 60*OneDay;
-
-var
-  PK : PEVP_PKEY;
-  X509 : PX509;
-  RSA : PRSA;
-  UTC : PASN1_UTCTIME;
-  SN : PX509_NAME;
-  B : PBIO;
-
+function TSSLSocketHandler.GetString(AIndex: Integer): string;
 begin
-  Result:=False;
-  PK:=Nil;
-  X509:=Nil;
-  try
-    PK:=EvpPkeynew;
-    X509:=X509New;
-    RSA:=RsaGenerateKey(1024,$10001,nil,nil);
-    EvpPkeyAssign(PK,EVP_PKEY_RSA,RSA);
-    X509SetVersion(X509,2);
-    Asn1IntegerSet(X509getSerialNumber(X509),0);
-    UTC:=Asn1UtctimeNew;
-    try
-      X509GmtimeAdj(UTC,-OneDay);
-      X509SetNotBefore(X509,UTC);
-      X509GmtimeAdj(UTC,SixtyDays);
-      X509SetNotAfter(X509,UTC);
-    finally
-      Asn1UtctimeFree(UTC);
-    end;
-    X509SetPubkey(X509,PK);
-    SN:=X509GetSubjectName(X509);
-    X509NameAddEntryByTxt(SN,'C',$1001,'CZ',-1,-1,0);
-    X509NameAddEntryByTxt(SN,'CN',$1001, AHostName,-1,-1,0);
-    x509SetIssuerName(X509,SN);
-    x509Sign(X509,PK,EvpGetDigestByName('SHA1'));
-    B:=BioNew(BioSMem);
-    try
-      i2dX509Bio(B,X509);
-      Certificate.Value:=BioToString(B);
-    finally
-      BioFreeAll(b);
-    end;
-    B:=BioNew(BioSMem);
-    try
-      i2dPrivatekeyBio(B,PK);
-      Privatekey.Value:=BioToString(B);
-    finally
-      BioFreeAll(b);
-    end;
-  finally
-    X509free(X509);
-    EvpPkeyFree(PK);
+  Case AIndex of
+    0 : Result:=FCertificateData.KeyPassword;
+    1 : Result:=FCertificateData.CipherList;
+    2 : Result:=FCertificateData.HostName;
   end;
 end;
 
-function TSSLSocketHandler.Connect: Boolean;
+procedure TSSLSocketHandler.SetCertificateData(AValue: TCertificateData);
 begin
-  Result:=Inherited Connect;
-  Result := Result and InitContext(False);
-  if Result then
-    begin
-    Result:=CheckSSL(FSSL.SetFD(FSocket.Handle));
-    if Result then
-     begin
-     if FSendHostAsSNI  and (FSocket is TInetSocket) then
-       FSSL.Ctrl(SSL_CTRL_SET_TLSEXT_HOSTNAME,TLSEXT_NAMETYPE_host_name,PAnsiChar(AnsiString((FSocket as TInetSocket).Host)));
-     Result:=CheckSSL(FSSL.Connect);
-     if Result and VerifyPeerCert then
-       Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);
-     if Result then
-       FSSLActive:=True;
-     end;
-    end;
+  if FCertificateData=AValue then Exit;
+  FCertificateData.Assign(AValue);
 end;
 
-function TSSLSocketHandler.Close: Boolean;
+procedure TSSLSocketHandler.SetSSLData(AIndex: Integer; AValue: TSSLData);
 begin
-  Result:=Shutdown(False);
+  Case aIndex of
+    0 : FCertificateData.Certificate:=AValue;
+    1 : FCertificateData.TrustedCertificate:=AValue;
+    2 : FCertificateData.PrivateKey:=AValue;
+    3 : FCertificateData.PFX:=AValue;
+    4 : FCertificateData.CertCA:=AValue;
+  end;
 end;
 
-Function TSSLSocketHandler.FetchErrorInfo : Boolean;
 
-var
-  S : AnsiString;
 
+procedure TSSLSocketHandler.SetString(AIndex: Integer; AValue: string);
 begin
-  FSSLLastErrorString:='';
-  FLastError:=ErrGetError;
-  ErrClearError;
-  Result:=(FLastError<>0);
-  if not Result then
-    begin
-    S:=StringOfChar(#0,256);
-    ErrErrorString(FLastError,S,256);
-    FSSLLastErrorString:=s;
-    end;
-end;
-
-function TSSLSocketHandler.CheckSSL(SSLResult : Integer) : Boolean;
-
-begin
-  Result:=SSLResult>=1;
-  if Not Result then
-     begin
-     FLastError:=SSLResult;
-     FetchErrorInfo;
-     end;
+  Case AIndex of
+    0 : FCertificateData.KeyPassword:=AValue;
+    1 : FCertificateData.CipherList:=AValue;
+    2 : begin
+        FCertificateData.HostName:=AValue;
+        FCertGenerator.HostName:=aValue;
+        end;
+  end;
 end;
 
-function TSSLSocketHandler.CheckSSL(SSLResult: Pointer): Boolean;
+procedure TSSLSocketHandler.SetSSLActive(aValue: Boolean);
 begin
-  Result:=(SSLResult<>Nil);
-  if not Result then
-    Result:=FetchErrorInfo;
+  FSSLActive:=aValue;
 end;
 
-function TSSLSocketHandler.DoneContext: Boolean;
 
+function TSSLSocketHandler.DoVerifyCert: boolean;
 begin
-  FreeAndNil(FSSL);
-  FreeAndNil(FCTX);
-  ErrRemoveState(0);
-  FSSLActive:=False;
   Result:=True;
+  If Assigned(OnVerifyCertificate) then
+    OnVerifyCertificate(Self,Result);
 end;
 
-Function HandleSSLPwd(buf : PAnsiChar; len:Integer; flags:Integer; UD : Pointer):Integer; cdecl;
-
-var
-  Pwd: AnsiString;
-  H :  TSSLSocketHandler;
+constructor TSSLSocketHandler.Create;
 
 begin
-  if Not Assigned(UD) then
-    PWD:=''
-  else
-    begin
-    H:=TSSLSocketHandler(UD);
-    Pwd:=H.KeyPassword;
-    end;
-  if (len<Length(Pwd)+1) then
-    SetLength(Pwd,len-1);
-  pwd:=pwd+#0;
-  Result:=Length(Pwd);
-  Move(Pointer(Pwd)^,Buf^,Result);
+  inherited Create;
+  FSendHostAsSNI:=True;
+  FCertGenerator:=CreateCertGenerator;
+  FCertificateData:=CreateCertificateData;
 end;
 
-function TSSLSocketHandler.InitSslKeys: boolean;
+Destructor TSSLSocketHandler.Destroy;
 
 begin
-  Result:=(FCTX<>Nil);
-  if not Result then
-    Exit;
-  if not Certificate.Empty then
-    Result:=CheckSSL(FCTX.UseCertificate(Certificate));
-  if Result and not PrivateKey.Empty then
-    Result:=CheckSSL(FCTX.UsePrivateKey(PrivateKey));
-  if Result and (CertCA.FileName<>'') then
-    Result:=CheckSSL(FCTX.LoadVerifyLocations(CertCA.FileName,''));
-  if Result and not PFX.Empty then
-    Result:=CheckSSL(FCTX.LoadPFX(PFX,Self.KeyPassword));
+  FreeAndNil(FCertificateData);
+  FreeAndNil(FCertGenerator);
+  inherited Destroy;
 end;
 
-function TSSLSocketHandler.InitContext(NeedCertificate:Boolean): Boolean;
-
-Const
-  VO : Array[Boolean] of Integer = (SSL_VERIFY_NONE,SSL_VERIFY_PEER);
-
-var
-  s: AnsiString;
-
+class procedure TSSLSocketHandler.SetDefaultHandlerClass(aClass: TSSLSocketHandlerClass);
 begin
-  Result:=DoneContext;
-  if Not Result then
-    Exit;
-  try
-    FCTX:=TSSLContext.Create(SSLType);
-  Except
-    CheckSSL(Nil);
-    Result:=False;
-    Exit;
-  end;
-  S:=FCipherList;
-  FCTX.SetCipherList(S);
-  FCTX.SetVerify(VO[FVerifypeerCert],Nil);
-  FCTX.SetDefaultPasswdCb(@HandleSSLPwd);
-  FCTX.SetDefaultPasswdCbUserdata(self);
-  If NeedCertificate and Certificate.Empty and PFX.Empty then
-    if Not CreateSelfSignedCertificate(RemoteHostName) then
-      begin
-      DoneContext;
-      Exit(False);
-      end;
-   if Not InitSSLKeys then
-     begin
-     DoneContext;
-     Exit(False);
-     end;
-   try
-     FSSL:=TSSL.Create(FCTX);
-     Result:=True;
-   Except
-     CheckSSL(Nil);
-     DoneContext;
-     Result:=False;
-   end;
+  FDefaultHandlerClass:=aClass;
 end;
 
-function TSSLSocketHandler.Accept: Boolean;
-
+class function TSSLSocketHandler.GetDefaultHandlerClass: TSSLSocketHandlerClass;
 begin
-  Result:=InitContext(True);
-  if Result then
-    begin
-    Result:=CheckSSL(FSSL.setfd(Socket.Handle));
-    if Result then
-      Result:=CheckSSL(FSSL.Accept);
-    end;
-  FSSLActive:=Result;
+  Result:=FDefaultHandlerClass;
 end;
 
-function TSSLSocketHandler.Shutdown(BiDirectional : Boolean): boolean;
-
-var
-  r : integer;
-
+class function TSSLSocketHandler.GetDefaultHandler: TSSLSocketHandler;
 begin
-  Result:=assigned(FSsl);
-  if Result then
-    If Not BiDirectional then
-      Result:=CheckSSL(FSSL.Shutdown)
-    else
-      begin
-      r:=FSSL.Shutdown;
-      if r<>0 then
-        Result:=CheckSSL(r)
-      else
-        begin
-        Result:=fpShutdown(FSocket.Handle,1)=0;
-        if Result then
-          Result:=CheckSSL(FSsl.Shutdown);
-        end
-      end;
-  If Result then
-    Result:=DoneContext;
+  if FDefaultHandlerClass=Nil then
+    Raise ESSLSocketError.Create(SErrNoSSLSupport);
+  Result:=FDefaultHandlerClass.Create;
 end;
 
-function TSSLSocketHandler.Send(Const Buffer; Count: Integer): Integer;
-var
-  e: integer;
+function TSSLSocketHandler.CreateCertificateData: TCertificateData;
 begin
-  FLastError := 0;
-  FSSLLastErrorString:='';
-  repeat
-    Result:=FSsl.Write(@Buffer,Count);
-    e:=FSsl.GetError(Result);
-  until Not (e in [SSL_ERROR_WANT_READ,SSL_ERROR_WANT_WRITE]);
-  if (E=SSL_ERROR_ZERO_RETURN) then
-    Result:=0
-  else if (e<>0) then
-    FLastError:=e;
+  Result:=TCertificateData.Create;
 end;
 
-function TSSLSocketHandler.Recv(Const Buffer; Count: Integer): Integer;
-
-var
-  e: integer;
+function TSSLSocketHandler.CreateCertGenerator: TX509Certificate;
 begin
-  FLastError:=0;
-  FSSLLastErrorString:= '';
-  repeat
-    Result:=FSSL.Read(@Buffer ,Count);
-    e:=FSSL.GetError(Result);
-  until Not (e in [SSL_ERROR_WANT_READ,SSL_ERROR_WANT_WRITE]);
-  if (E=SSL_ERROR_ZERO_RETURN) then
-    Result:=0
-  else if (e<>0) then
-    FLastError:=e;
+  Raise ESSLSocketError.Create(SErrNoX509Certificate);
 end;
 
-function TSSLSocketHandler.BytesAvailable: Integer;
-begin
-  Result:= FSSL.Pending;
-end;
+function TSSLSocketHandler.CreateSelfSignedCertificate: Boolean;
 
-Function TSSLSocketHandler.SSLActive: Boolean;
-begin
-  Result:=FSSLActive;
-end;
+Var
+  CK:TCertAndKey;
 
-Function TSSLSocketHandler.SSLLastError: integer;
 begin
-  Result:=FLastError;
+  CK:=CertGenerator.CreateCertificateAndKey;
+  CertificateData.Certificate.Value:=CK.Certificate;
+  CertificateData.PrivateKey.Value:=CK.PrivateKey;
+  Result:=(Length(CK.Certificate)<>0) and (Length(CK.PrivateKey)<>0);
 end;
 
+
 end.
 

packages/fcl-net/src/ssockets.pp

@@ -45,24 +45,26 @@ type
 
   TAcceptErrorAction = (aeaRaise,aeaIgnore,aeaStop);
   TSocketStream = Class;
+  TSocketServer = Class;
 
   // Handles all OS calls
 
   { TSocketHandler }
 
   TSocketHandler = Class(TObject)
+  Private
+    FServer: TSocketServer;
     FSocket: TSocketStream;
-    FLastError : integer;
   Protected
+    FLastError : integer;
     Procedure SetSocket(const AStream: TSocketStream); virtual;
     Procedure CheckSocket;
   Public
     constructor Create; virtual;
     // Called after the connect call succeded. Returns True to continue, false to close connection.
     function Connect: boolean; virtual;
-    // Called after the accept call succeded.
+    // Called after the accept call succeded on the NEW client socket
     function Accept : Boolean; virtual;
-
     Function Close : Boolean; virtual;
     function Shutdown(BiDirectional : Boolean): boolean; virtual;
     function Recv(Const Buffer; Count: Integer): Integer; virtual;
@@ -111,6 +113,7 @@ type
   TConnectEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
   TConnectQuery = Procedure (Sender : TObject; ASocket : Longint; Var Allow : Boolean) of Object;
   TOnAcceptError = Procedure (Sender : TObject; ASocket : Longint; E : Exception; Var ErrorAction : TAcceptErrorAction) of Object;
+  TGetClientSocketHandlerEvent = Procedure (Sender : TObject; Out AHandler : TSocketHandler) of object;
 
   { TSocketServer }
 
@@ -118,6 +121,7 @@ type
   Private
     FIdleTimeOut: Cardinal;
     FOnAcceptError: TOnAcceptError;
+    FOnCreateClientSocketHandler: TGetClientSocketHandlerEvent;
     FOnIdle : TNotifyEvent;
     FNonBlocking : Boolean;
     FSocket : longint;
@@ -148,6 +152,7 @@ type
     Function RunIdleLoop : Boolean;
     function GetConnection: TSocketStream; virtual; abstract;
     Function HandleAcceptError(E : ESocketError) : TAcceptErrorAction;
+    Function GetClientSocketHandler(aSocket : Longint) : TSocketHandler; virtual;
     Property Handler : TSocketHandler Read FHandler;
   Public
     Constructor Create(ASocket : Longint; AHandler : TSocketHandler);
@@ -176,6 +181,7 @@ type
     // Accept Timeout in milliseconds.
     // If Different from 0, then there will be an idle loop before accepting new connections, Calling OnIdle if no new connection appeared in the specified timeout.
     Property AcceptIdleTimeOut : Cardinal Read FIdleTimeOut Write FIdleTimeout;
+    Property OnCreateClientSocketHandler : TGetClientSocketHandlerEvent Read FOnCreateClientSocketHandler Write FOnCreateClientSocketHandler;
   end;
 
   { TInetServer }
@@ -256,6 +262,7 @@ type
   end;
 {$endif}
 
+
 Implementation
 
 uses
@@ -379,6 +386,7 @@ begin
   Result:=True;
 end;
 
+
 constructor ESocketError.Create(ACode: TSocketErrorType; const MsgArgs: array of const);
 var
   s: String;
@@ -658,6 +666,15 @@ begin
     FOnAcceptError(Self,FSocket,E,Result);
 end;
 
+function TSocketServer.GetClientSocketHandler(aSocket : Longint): TSocketHandler;
+begin
+  If Assigned(FOnCreateClientSocketHandler) then
+    FOnCreateClientSocketHandler(Self,Result)
+  else
+    if Assigned(FHandler) then
+      Result:=TSocketHandlerClass(FHandler.ClassType).Create;
+end;
+
 procedure TSocketServer.StartAccepting;
 
 Var
@@ -856,10 +873,19 @@ end;
 
 Function  TInetServer.SockToStream (ASocket : Longint) : TSocketStream;
 
+Var
+  H : TSocketHandler;
+
 begin
-  Result:=TInetSocket.Create(ASocket);
+  H:=GetClientSocketHandler(aSocket);
+  Result:=TInetSocket.Create(ASocket,H);
   (Result as TInetSocket).FHost:='';
   (Result as TInetSocket).FPort:=FPort;
+  if Not H.Accept then
+    begin
+    H.Shutdown(False);
+    FreeAndNil(Result);
+    end;
 end;
 
 Function TInetServer.Accept : Longint;
@@ -882,7 +908,7 @@ begin
     If R=ESysEWOULDBLOCK then
       Raise ESocketError.Create(seAcceptWouldBlock,[socket]);
 {$endif}
-  if (Result<0) or Not (FAccepting and FHandler.Accept) then
+  if (Result<0) or Not FAccepting then
     begin
     If (Result>=0) then
       CloseSocket(Result);

packages/fcl-web/examples/httpclient/httpget.pas

@@ -3,7 +3,7 @@ program httpget;
 {$mode objfpc}{$H+}
 
 uses
-  SysUtils, Classes, fphttpclient, sslsockets, fpopenssl;
+  SysUtils, Classes, fphttpclient, sslsockets, fpopenssl, opensslsockets;
 
 Type
 

packages/fcl-web/examples/httpclient/httppost.pp

@@ -3,7 +3,7 @@ program httppost;
 {$mode objfpc}{$H+}
 
 uses
-  SysUtils, Classes, fphttpclient;
+  SysUtils, Classes, fphttpclient, opensslsockets;
 
 Var
   F : TFileStream;

packages/fcl-web/examples/httpclient/httppostfile.pp

@@ -3,7 +3,7 @@ program httppostfile;
 {$mode objfpc}{$H+}
 
 uses
-  SysUtils, Classes, fphttpclient;
+  SysUtils, Classes, fphttpclient, opensslsockets;
 
 Var
   F : TFileStream;

packages/fcl-web/examples/httpclient/keepalive.pp

@@ -3,7 +3,7 @@ program keepalive;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, SysUtils, CustApp, fphttpclient;
+  Classes, SysUtils, CustApp, fphttpclient, opensslsockets;
 
 const
   URL_DIRECT = 'https://www.google.com/humans.txt';

packages/fcl-web/examples/simpleserver/simpleserver.lpi

@@ -4,8 +4,12 @@
     <Version Value="11"/>
     <General>
       <Flags>
+        <SaveClosedFiles Value="False"/>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <SaveJumpHistory Value="False"/>
+        <SaveFoldState Value="False"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
@@ -20,16 +24,31 @@
       <Version Value="2"/>
     </PublishOptions>
     <RunParams>
+      <local>
+        <CommandLineParams Value="-p 3003 -s -H nickname.freepascal.org"/>
+      </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
-        <Mode0 Name="default"/>
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="-p 3003 -s -H nickname.freepascal.org"/>
+          </local>
+        </Mode0>
       </Modes>
     </RunParams>
-    <Units Count="1">
+    <Units Count="3">
       <Unit0>
         <Filename Value="simpleserver.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit0>
+      <Unit1>
+        <Filename Value="sslbase.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="opensslsockets.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -2,7 +2,7 @@
 {$h+}
 program simpleserver;
 
-uses sysutils,custhttpapp, fpwebfile;
+uses sysutils, custhttpapp, fpwebfile, sslbase, opensslsockets;
 
 Type
 
@@ -48,6 +48,8 @@ begin
   Writeln('-p --port=NNNN      TCP/IP port to listen on (default is 3000)');
   Writeln('-m --mimetypes=file path of mime.types, default under unix: /etc/mime.types');
   Writeln('-q --quiet          Do not write diagnostic messages');
+  Writeln('-s --ssl            Use SSL');
+  Writeln('-H --hostname=NAME  set hostname for self-signed SSL certificate');
   Halt(Ord(Msg<>''));
 end;
 
@@ -57,7 +59,7 @@ Var
   S,IndexPage,D : String;
 
 begin
-  S:=Checkoptions('hqd:ni:p:',['help','quiet','noindexpage','directory:','port:','indexpage:']);
+  S:=Checkoptions('hqd:ni:p:sH:',['help','quiet','noindexpage','directory:','port:','indexpage:','ssl','hostname:']);
   if (S<>'') or HasOption('h','help') then
     usage(S);
   Quiet:=HasOption('q','quiet');
@@ -66,7 +68,9 @@ begin
   if D='' then
     D:=GetCurrentDir;
   Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
-
+  UseSSL:=HasOption('s','ssl');
+  if HasOption('H','hostname') then
+    HostName:=GetOptionValue('H','hostname');
   if HasOption('m','mimetypes') then
     MimeTypesFile:=GetOptionValue('m','mimetypes');
 {$ifdef unix}

packages/fcl-web/fpmake.pp

@@ -26,6 +26,7 @@ begin
     P.Dependencies.Add('fcl-net');
     P.Dependencies.Add('fcl-process');
     P.Dependencies.Add('fcl-fpcunit');
+    P.Dependencies.Add('openssl',AllUnixOSes+AllWindowsOSes);
     P.Dependencies.Add('fastcgi');
     P.Dependencies.Add('httpd22', AllOses - [amiga,aros,morphos]);
     P.Dependencies.Add('httpd24', AllOses - [amiga,aros,morphos]);

packages/fcl-web/src/base/custhttpapp.pp

@@ -51,11 +51,14 @@ Type
     FServer: TEmbeddedHTTPServer;
     function GetAllowConnect: TConnectQuery;
     function GetAddress: string;
+    function GetHostName: String;
     function GetIdle: TNotifyEvent;
     function GetIDleTimeOut: Cardinal;
     function GetPort: Word;
     function GetQueueSize: Word;
     function GetThreaded: Boolean;
+    function GetUseSSL: Boolean;
+    procedure SetHostName(AValue: String);
     procedure SetIdle(AValue: TNotifyEvent);
     procedure SetIDleTimeOut(AValue: Cardinal);
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
@@ -65,6 +68,7 @@ Type
     procedure SetThreaded(const AValue: Boolean);
     function GetLookupHostNames : Boolean;
     Procedure SetLookupHostnames(Avalue : Boolean);
+    procedure SetUseSSL(AValue: Boolean);
   protected
     procedure HTTPHandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse); virtual;
     procedure HandleRequestError(Sender: TObject; E: Exception); virtual;
@@ -96,6 +100,10 @@ Type
     Property OnAcceptIdle : TNotifyEvent Read GetIdle Write SetIdle;
     // If >0, when no new connection appeared after timeout, OnAcceptIdle is called.
     Property AcceptIdleTimeout : Cardinal Read GetIDleTimeOut Write SetIDleTimeOut;
+    // Use SSL or not ?
+    Property UseSSL : Boolean Read GetUseSSL Write SetUseSSL;
+    // HostName to use when using SSL
+    Property HostName : String Read GetHostName Write SetHostName;
   end;
 
   { TCustomHTTPApplication }
@@ -103,9 +111,12 @@ Type
   TCustomHTTPApplication = Class(TCustomWebApplication)
   private
     procedure FakeConnect;
+    function GetHostName: String;
     function GetIdle: TNotifyEvent;
     function GetIDleTimeOut: Cardinal;
     function GetLookupHostNames : Boolean;
+    function GetUseSSL: Boolean;
+    procedure SetHostName(AValue: String);
     procedure SetIdle(AValue: TNotifyEvent);
     procedure SetIDleTimeOut(AValue: Cardinal);
     Procedure SetLookupHostnames(Avalue : Boolean);
@@ -119,6 +130,7 @@ Type
     procedure SetPort(const AValue: Word);
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
+    procedure SetUseSSL(AValue: Boolean);
   protected
     function InitializeWebHandler: TWebHandler; override;
     Function HTTPHandler : TFPHTTPServerHandler;
@@ -138,6 +150,10 @@ Type
     Property OnAcceptIdle : TNotifyEvent Read GetIdle Write SetIdle;
     // If >0, when no new connection appeared after timeout, OnAcceptIdle is called.
     Property AcceptIdleTimeout : Cardinal Read GetIDleTimeOut Write SetIDleTimeOut;
+    // Use SSL ?
+    Property UseSSL : Boolean Read GetUseSSL Write SetUseSSL;
+    // Hostname to use when using SSL
+    Property HostName : String Read GetHostName Write SetHostName;
   end;
 
 
@@ -179,6 +195,16 @@ begin
   Result:=HTTPHandler.LookupHostNames;
 end;
 
+function TCustomHTTPApplication.GetUseSSL: Boolean;
+begin
+
+end;
+
+procedure TCustomHTTPApplication.SetHostName(AValue: String);
+begin
+  HTTPHandler.HostName:=aValue;
+end;
+
 procedure TCustomHTTPApplication.SetIdle(AValue: TNotifyEvent);
 begin
   HTTPHandler.OnAcceptIdle:=AValue;
@@ -245,6 +271,11 @@ begin
   HTTPHandler.Threaded:=Avalue;
 end;
 
+procedure TCustomHTTPApplication.SetUseSSL(AValue: Boolean);
+begin
+  HTTPHandler.UseSSL:=aValue;
+end;
+
 function TCustomHTTPApplication.InitializeWebHandler: TWebHandler;
 begin
   Result:=TFPHTTPServerHandler.Create(Self);
@@ -265,6 +296,11 @@ begin
   end
 end;
 
+function TCustomHTTPApplication.GetHostName: String;
+begin
+  Result:=HTTPHandler.HostName;
+end;
+
 procedure TCustomHTTPApplication.Terminate;
 
 begin
@@ -316,6 +352,11 @@ begin
   FServer.LookupHostNames:=AValue;
 end;
 
+procedure TFPHTTPServerHandler.SetUseSSL(AValue: Boolean);
+begin
+  FServer.UseSSL:=aValue;
+end;
+
 function TFPHTTPServerHandler.GetAllowConnect: TConnectQuery;
 begin
   Result:=FServer.OnAllowConnect;
@@ -326,6 +367,11 @@ begin
   Result:=FServer.Address;
 end;
 
+function TFPHTTPServerHandler.GetHostName: String;
+begin
+  Result:=FServer.HostName;
+end;
+
 function TFPHTTPServerHandler.GetIdle: TNotifyEvent;
 begin
   Result:=FServer.OnAcceptIdle;
@@ -351,6 +397,16 @@ begin
   Result:=FServer.Threaded;
 end;
 
+function TFPHTTPServerHandler.GetUseSSL: Boolean;
+begin
+  Result:=FServer.UseSSL;
+end;
+
+procedure TFPHTTPServerHandler.SetHostName(AValue: String);
+begin
+  FServer.HostName:=aValue;
+end;
+
 procedure TFPHTTPServerHandler.SetIdle(AValue: TNotifyEvent);
 begin
   FServer.OnAcceptIdle:=AValue;

packages/fcl-web/src/base/fphttpclient.pp

@@ -41,6 +41,7 @@ Type
   TDataEvent   = Procedure (Sender : TObject; Const ContentLength, CurrentPos : Int64) of object;
   // Use this to set up a socket handler. UseSSL is true if protocol was https
   TGetSocketHandlerEvent = Procedure (Sender : TObject; Const UseSSL : Boolean; Out AHandler : TSocketHandler) of object;
+  TSocketHandlerCreatedEvent = Procedure (Sender : TObject; AHandler : TSocketHandler) of object;
 
   TFPCustomHTTPClient = Class;
 
@@ -95,6 +96,7 @@ Type
     FTerminated: Boolean;
     FUserName: String;
     FOnGetSocketHandler : TGetSocketHandlerEvent;
+    FAfterSocketHandlerCreated : TSocketHandlerCreatedEvent;
     FProxy : TProxyData;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
@@ -326,7 +328,8 @@ Type
     Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
     // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
     Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
-
+    // Called after create socket handler was created, with the created socket handler.
+    Property AfterSocketHandlerCreate : TSocketHandlerCreatedEvent Read FAfterSocketHandlerCreated Write FAfterSocketHandlerCreated;
   end;
 
 
@@ -587,12 +590,12 @@ begin
   if Assigned(FonGetSocketHandler) then
     FOnGetSocketHandler(Self,UseSSL,Result);
   if (Result=Nil) then
-  {$if not defined(HASAMIGA)}
     If UseSSL then
-      Result:=TSSLSocketHandler.Create
+      Result:=TSSLSocketHandler.GetDefaultHandler
     else
-  {$endif}  
       Result:=TSocketHandler.Create;
+  if Assigned(AfterSocketHandlerCreate) then
+    AfterSocketHandlerCreate(Self,Result);
 end;
 
 procedure TFPCustomHTTPClient.ConnectToServer(const AHost: String;

packages/fcl-web/src/base/fphttpserver.pp

@@ -20,7 +20,7 @@ unit fphttpserver;
 interface
 
 uses
-  Classes, SysUtils, sockets, ssockets, resolve, httpdefs;
+  Classes, SysUtils, sockets, sslbase, sslsockets, ssockets, resolve, httpdefs;
 
 Const
   ReadBufLen = 4096;
@@ -30,6 +30,8 @@ Type
   TFPHTTPConnectionThread = Class;
   TFPCustomHttpServer = Class;
   TRequestErrorHandler = Procedure (Sender : TObject; E : Exception) of object;
+  TGetSocketHandlerEvent = Procedure (Sender : TObject; Const UseSSL : Boolean; Out AHandler : TSocketHandler) of object;
+  TSocketHandlerCreatedEvent = Procedure (Sender : TObject; AHandler : TSocketHandler) of object;
 
   { TFPHTTPConnectionRequest }
 
@@ -104,8 +106,12 @@ Type
     FAcceptIdleTimeout: Cardinal;
     FAdminMail: string;
     FAdminName: string;
+    FAfterSocketHandlerCreated: TSocketHandlerCreatedEvent;
+    FCertificateData: TCertificateData;
+    FHostName: string;
     FOnAcceptIdle: TNotifyEvent;
     FOnAllowConnect: TConnectQuery;
+    FOnGetSocketHandler: TGetSocketHandlerEvent;
     FOnRequest: THTTPServerRequestHandler;
     FOnRequestError: TRequestErrorHandler;
     FAddress: string;
@@ -117,9 +123,14 @@ Type
     FLookupHostNames,
     FThreaded: Boolean;
     FConnectionCount : Integer;
+    FUseSSL: Boolean;
+    procedure DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler);
     function GetActive: Boolean;
+    function GetHostName: string;
     procedure SetAcceptIdleTimeout(AValue: Cardinal);
     procedure SetActive(const AValue: Boolean);
+    procedure SetCertificateData(AValue: TCertificateData);
+    procedure SetHostName(AValue: string);
     procedure SetIdle(AValue: TNotifyEvent);
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
     procedure SetAddress(const AValue: string);
@@ -129,6 +140,12 @@ Type
     procedure SetupSocket;
     procedure WaitForRequests;
   Protected
+    // Override this to create descendent
+    function CreateSSLSocketHandler: TSocketHandler;
+    // Override this to create descendent
+    Function CreateCertificateData : TCertificateData; virtual;
+    // Override this to create descendent
+    Function GetSocketHandler(Const UseSSL : Boolean) : TSocketHandler;  virtual;
     // Override these to create descendents of the request/response instead.
     Function CreateRequest : TFPHTTPConnectionRequest; virtual;
     Function CreateResponse(ARequest : TFPHTTPConnectionRequest) : TFPHTTPConnectionResponse; virtual;
@@ -189,6 +206,17 @@ Type
     property AdminName: string read FAdminName write FAdminName;
     property ServerBanner: string read FServerBanner write FServerBanner;
     Property LookupHostNames : Boolean Read FLookupHostNames Write FLookupHostNames;
+    // You need to set this if you want to use SSL
+    property HostName : string Read GetHostName Write SetHostName; deprecated 'Use certificatedata instead';
+    // Properties to use when doing SSL handshake
+    Property CertificateData  : TCertificateData Read FCertificateData Write SetCertificateData;
+    // Set to true if you want to use SSL
+    Property UseSSL : Boolean Read FUseSSL Write FUseSSL;
+    // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
+    Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
+    // Called after create socket handler was created, with the created socket handler.
+    Property AfterSocketHandlerCreate : TSocketHandlerCreatedEvent Read FAfterSocketHandlerCreated Write FAfterSocketHandlerCreated;
+
   end;
 
   TFPHttpServer = Class(TFPCustomHttpServer)
@@ -480,6 +508,7 @@ Var
   S : String;
 
 begin
+  S:='';
   L:=ARequest.ContentLength;
   If (L>0) then
     begin
@@ -648,6 +677,16 @@ begin
     Result:=Assigned(FServer);
 end;
 
+procedure TFPCustomHttpServer.DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler);
+begin
+  AHandler:=GetSocketHandler(UseSSL);
+end;
+
+function TFPCustomHttpServer.GetHostName: string;
+begin
+  Result:=FCertificateData.HostName;
+end;
+
 procedure TFPCustomHttpServer.SetAcceptIdleTimeout(AValue: Cardinal);
 begin
   if FAcceptIdleTimeout=AValue then Exit;
@@ -677,6 +716,17 @@ begin
       StopServerSocket;
 end;
 
+procedure TFPCustomHttpServer.SetCertificateData(AValue: TCertificateData);
+begin
+  if FCertificateData=AValue then Exit;
+  FCertificateData:=AValue;
+end;
+
+procedure TFPCustomHttpServer.SetHostName(AValue: string);
+begin
+  FCertificateData.HostName:=aValue;
+end;
+
 procedure TFPCustomHttpServer.SetIdle(AValue: TNotifyEvent);
 begin
   FOnAcceptIdle:=AValue;
@@ -787,11 +837,13 @@ begin
 end;
 
 procedure TFPCustomHttpServer.CreateServerSocket;
+
 begin
   if FAddress='' then
     FServer:=TInetServer.Create(FPort)
   else
     FServer:=TInetServer.Create(FAddress,FPort);
+  FServer.OnCreateClientSocketHandler:=@DoCreateClientHandler;
   FServer.MaxConnections:=-1;
   FServer.OnConnectQuery:=OnAllowConnect;
   FServer.OnConnect:=@DOConnect;
@@ -824,7 +876,8 @@ begin
   inherited Create(AOwner);
   FPort:=80;
   FQueueSize:=5;
-  FServerBanner := 'Freepascal';
+  FServerBanner := 'FreePascal';
+  FCertificateData:=CreateCertificateData;
 end;
 
 procedure TFPCustomHttpServer.WaitForRequests;
@@ -845,11 +898,57 @@ begin
     end;
 end;
 
+function TFPCustomHttpServer.CreateCertificateData: TCertificateData;
+begin
+  Result:=TCertificateData.Create;
+end;
+
+function TFPCustomHttpServer.CreateSSLSocketHandler : TSocketHandler;
+
+Var
+  S : TSSLSocketHandler;
+  CK : TCertAndKey;
+
+begin
+  S:=TSSLSocketHandler.GetDefaultHandler;
+  try
+    // We must create the certificate once in our global copy of CertificateData !
+    if CertificateData.NeedCertificateData then
+      begin
+      S.CertGenerator.HostName:=CertificateData.Hostname;
+      CK:=S.CertGenerator.CreateCertificateAndKey;
+      CertificateData.Certificate.Value:=CK.Certificate;
+      CertificateData.PrivateKey.Value:=CK.PrivateKey;
+      end;
+    S.CertificateData:=Self.CertificateData;
+    Result:=S;
+  except
+    S.free;
+    Raise;
+  end;
+end;
+
+function TFPCustomHttpServer.GetSocketHandler(const UseSSL: Boolean): TSocketHandler;
+
+begin
+  Result:=Nil;
+  if Assigned(FonGetSocketHandler) then
+    FOnGetSocketHandler(Self,UseSSL,Result);
+  if (Result=Nil) then
+    If UseSSL then
+      Result:=CreateSSLSocketHandler
+    else
+      Result:=TSocketHandler.Create;
+  if Assigned(FAfterSocketHandlerCreated) then
+    FAfterSocketHandlerCreated(Self,Result);
+end;
+
 destructor TFPCustomHttpServer.Destroy;
 begin
   Active:=False;
   if Threaded and (FConnectionCount>0) then
     WaitForRequests;
+  FreeAndNil(FCertificateData);
   inherited Destroy;
 end;
 

packages/openssl/fpmake.pp

@@ -13,6 +13,7 @@ begin
 {$endif ALLPACKAGES}
 
     P:=AddPackage('openssl');
+    P.Dependencies.Add('fcl-net');
     P.ShortName:='ossl';
     P.Description := 'Interface units for OpenSSL libraries supporting SSL-encrypted network communication.';
 {$ifdef ALLPACKAGES}
@@ -29,6 +30,9 @@ begin
     T:=P.Targets.AddUnit('openssl.pas');
     T:=P.Targets.AddUnit('fpopenssl.pp');
       T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('opensslsockets.pp');
+      T.ResourceStrings:=true;
+      T.Dependencies.AddUnit('openssl');
 
     P.ExamplePath.Add('examples');
     P.Targets.AddExampleProgram('test1.pas');

packages/openssl/src/fpopenssl.pp

@@ -15,31 +15,23 @@
 unit fpopenssl;
 
 {$mode objfpc}{$H+}
+{$DEFINE DUMPCERT}
 
 interface
 
 uses
-  Classes, SysUtils, openssl, ctypes;
-Type
-  TSSLType = (stAny,stSSLv2,stSSLv3,stTLSv1,stTLSv1_1,stTLSv1_2);
-
-  //  PASN1_INTEGER = SslPtr;
-
-  { TSSLData }
-
-  TSSLData = Class(TPersistent)
-  private
-    FFileName: String;
-    FValue: String;
-  Public
-    Function Empty : Boolean;
-    Procedure Assign(Source : TPersistent);override;
-    Property FileName : String Read FFileName Write FFileName;
-    Property Value: String Read FValue Write FValue;
-  end;
+  Classes, SysUtils, sslbase, openssl, ctypes;
 
-  { TSocketHandler }
+{$IFDEF DUMPCERT}
+Const
+{$IFDEF UNIX}
+  DumpCertFile = '/tmp/x509.txt';
+{$ELSE}
+  DumpCertFile = 'C:\temp\x509.txt';
+{$ENDIF}
+{$ENDIF}
 
+Type
   { TSSLContext }
 
   TSSLContext = Class;
@@ -55,24 +47,27 @@ Type
     FCTX: PSSL_CTX;
     function UsePrivateKey(pkey: SslPtr): cInt;
     function UsePrivateKeyASN1(pk: cInt; d: String; len: cLong): cInt;
+    function UsePrivateKeyASN1(pk: cInt; d: TBytes; len: cLong): cInt;
     function UsePrivateKeyFile(const Afile: String; Atype: cInt): cInt;
   Public
     Constructor Create(AContext : PSSL_CTX = Nil); overload;
     Constructor Create(AType : TSSLType); overload;
     Destructor Destroy; override;
     Function SetCipherList(Var ACipherList : String) : Integer;
-    procedure SetVerify(mode: Integer; arg2: PFunction);
+    procedure SetVerify(mode: Integer; arg2: TSSLCTXVerifyCallback);
     procedure SetDefaultPasswdCb(cb: PPasswdCb);
     procedure SetDefaultPasswdCbUserdata(u: SslPtr);
     Function UsePrivateKey(Data : TSSLData) : cint;
     // Use certificate.
     Function UseCertificate(Data : TSSLData) : cint;
-    function UseCertificateASN1(len: cLong; d: String):cInt;
+    function UseCertificateASN1(len: cLong; d: String):cInt; overload; deprecated 'use TBytes overload';
+    function UseCertificateASN1(len: cLong; buf: TBytes):cInt; overload;
     function UseCertificateFile(const Afile: String; Atype: cInt):cInt;
     function UseCertificateChainFile(const Afile: PChar):cInt;
     function UseCertificate(x: SslPtr):cInt;
     function LoadVerifyLocations(const CAfile: String; const CApath: String):cInt;
-    function LoadPFX(Const S,APassword : AnsiString) : cint;
+    function LoadPFX(Const S,APassword : AnsiString) : cint; deprecated 'use TBytes overload';
+    function LoadPFX(Const Buf : TBytes;APassword : AnsiString) : cint;
     function LoadPFX(Data : TSSLData; Const APAssword : Ansistring) : cint;
     function SetOptions(AOptions: cLong): cLong;
     procedure SetTlsextServernameCallback(cb: PCallbackCb);
@@ -116,17 +111,30 @@ Type
     Property SSL: PSSL Read FSSL;
   end;
 
+
+  TOpenSSLX509Certificate = Class (TX509Certificate)
+  Protected
+    function CreateKey: PEVP_PKEY; virtual;
+    procedure SetNameData(x: PX509); virtual;
+    procedure SetTimes(x: PX509); virtual;
+  Public
+    Function CreateCertificateAndKey : TCertAndKey; override;
+  end;
+
   ESSL = Class(Exception);
 
-Function BioToString(B : PBIO) : AnsiString;
+Function BioToString(B : PBIO; FreeBIO : Boolean = False) : AnsiString;
 
 implementation
 
+uses dateutils;
+
 Resourcestring
   SErrCountNotGetContext = 'Failed to create SSL Context';
   SErrFailedToCreateSSL = 'Failed to create SSL';
 
-Function BioToString(B : PBIO) : AnsiString;
+
+Function BioToString(B : PBIO; FreeBIO : Boolean = False) : AnsiString;
 
 Var
   L,RL : Integer;
@@ -138,6 +146,25 @@ begin
     SetLength(Result,RL)
   else
     SetLength(Result,0);
+  if FreeBio then
+    BioFreeAll(B);
+end;
+
+Function BioToTBytes(B : PBIO; FreeBIO : Boolean = False) : TBytes;
+
+Var
+  L,RL : Integer;
+begin
+  l:=bioctrlpending(B);
+  SetLength(Result,l);
+  FillChar(Result[0],L,0);
+  RL:=BioRead(B,Result,L);
+  if (RL>0) then
+    SetLength(Result,RL)
+  else
+    SetLength(Result,0);
+  if FreeBio then
+    BioFreeAll(B);
 end;
 
 function SelectSNIContextCallback(ASSL: TSSL; ad: integer; arg: TTlsExtCtx): integer; cdecl;
@@ -167,6 +194,114 @@ begin
   result := SSL_TLSEXT_ERR_OK;
 end;
 
+{ TOpenSSLX509Certificate }
+
+
+procedure TOpenSSLX509Certificate.SetNameData(x: PX509);
+
+Var
+  ND : PX509_NAME;
+  S : AnsiString;
+
+  Procedure SetEntry(aCode,aValue : AnsiString);
+
+  begin
+    if (AValue<>'') then
+      X509NameAddEntryByTxt(ND, aCode, $1001, aValue, -1, -1, 0);
+  end;
+
+begin
+  ND:=X509GetSubjectName(x);
+  S:=Country;
+  if S='' then
+    S:='BE';
+  SetEntry('C',S);
+  S:=HostName;
+  if S='' then
+    S:='localhost';
+  SetEntry('CN',S);
+  SetEntry('O',Organization);
+  x509SetIssuerName(x,ND);
+end;
+
+Procedure TOpenSSLX509Certificate.SetTimes(x : PX509);
+
+var
+  Utc : PASN1_UTCTIME;
+
+begin
+  Utc:=Asn1UtctimeNew;
+  try
+    ASN1UtcTimeSetString(Utc,PAnsiChar(FormatDateTime('YYMMDDHHNNSS',ValidFrom)));
+    X509SetNotBefore(x, Utc);
+    ASN1UtcTimeSetString(Utc,PAnsiChar(FormatDateTime('YYMMDDHHNNSS',ValidTo)));
+    X509SetNotAfter(x,Utc);
+  finally
+    Asn1UtctimeFree(Utc);
+  end;
+end;
+
+
+function TOpenSSLX509Certificate.CreateKey : PEVP_PKEY;
+
+Var
+  rsa: PRSA;
+
+begin
+  Result:=EvpPkeynew;
+  rsa:=RsaGenerateKey(KeySize,$10001,nil,nil);
+  EvpPkeyAssign(Result,EVP_PKEY_RSA,rsa);
+end;
+
+function TOpenSSLX509Certificate.CreateCertificateAndKey: TCertAndKey;
+
+var
+  pk: PEVP_PKEY;
+  x: PX509;
+  b: PBIO;
+{$IFDEF DUMPCERT}
+  s : string;
+{$ENDIF}
+
+begin
+  SetLength(Result.Certificate,0);
+  SetLength(Result.PrivateKey,0);
+  pk := nil;
+  x := X509New;
+  try
+    X509SetVersion(x, Version);
+    Asn1IntegerSet(X509getSerialNumber(x), GetRealSerial);
+    SetTimes(X);
+    pk:=CreateKey;
+    X509SetPubkey(x, pk);
+    SetNameData(x);
+    x509Sign(x,pk,EvpGetDigestByName('SHA1'));
+    // Certificate
+    b := BioNew(BioSMem);
+    i2dX509Bio(b, x);
+    Result.Certificate:=BioToTbytes(B,True);
+    // Private key
+    b := BioNew(BioSMem);
+    i2dPrivatekeyBio(b, pk);
+    Result.PrivateKey:=BioToTbytes(B,True);
+{$IFDEF DUMPCERT}
+    b := BioNew(BioSMem);
+    PEM_write_bio_X509(b,x);
+    S:=BioToString(B,True);
+    With TStringList.Create do
+      try
+        Add(S);
+        SaveToFile(DumpCertFile);
+      finally
+        Free;
+      end;
+{$ENDIF}
+  finally
+    X509free(x);
+    EvpPkeyFree(pk);
+  end;
+end;
+
 { TSSLContext }
 
 Constructor TSSLContext.Create(AContext: PSSL_CTX);
@@ -211,7 +346,7 @@ begin
   Result:=SSLCTxSetCipherList(FCTX,ACipherList);
 end;
 
-procedure TSSLContext.SetVerify(mode: Integer; arg2: PFunction);
+procedure TSSLContext.SetVerify(mode: Integer; arg2: TSSLCTXVerifyCallback);
 begin
   SslCtxSetVerify(FCtx,Mode,arg2);
 end;
@@ -236,6 +371,11 @@ begin
   Result:=SslCtxUsePrivateKeyASN1(pk,FCtx,d,len);
 end;
 
+function TSSLContext.UsePrivateKeyASN1(pk: cInt; d: TBytes; len: cLong): cInt;
+begin
+  Result:=SslCtxUsePrivateKeyASN1(pk,FCtx,d,len);
+end;
+
 function TSSLContext.UsePrivateKeyFile(const Afile: String; Atype: cInt):cInt;
 begin
   Result:=SslCtxUsePrivateKeyFile(FCTX,AFile,AType);
@@ -245,44 +385,43 @@ end;
 Function TSSLContext.UsePrivateKey(Data: TSSLData): cint;
 
 Var
-  S : AnsiString;
+  FN : String;
+  l : integer;
 
 begin
   Result:=-1;
-  If (Data.Value<>'') then
-    begin
-    S:=Data.Value;
-    Result:=UsePrivateKeyASN1(EVP_PKEY_RSA,S,length(S));
-    end
+  L:=Length(Data.Value);
+  If (l<>0) then
+    Result:=UsePrivateKeyASN1(EVP_PKEY_RSA,Data.Value,L)
   else if (Data.FileName<>'') then
     begin
-    S:=Data.FileName;
-    Result:=UsePrivateKeyFile(S,SSL_FILETYPE_PEM);
+    FN:=Data.FileName;
+    Result:=UsePrivateKeyFile(FN,SSL_FILETYPE_PEM);
     if (Result<>1) then
-      Result:=UsePrivateKeyFile(S,SSL_FILETYPE_ASN1);
+      Result:=UsePrivateKeyFile(FN,SSL_FILETYPE_ASN1);
     end;
 end;
 
 Function TSSLContext.UseCertificate(Data: TSSLData): cint;
 
 Var
-  S : AnsiString;
+  l : integer;
+  FN : String;
+
 begin
   Result:=-1;
-  if (Data.Value<>'') then
-    begin
-    S:=Data.Value;
-    Result:=UseCertificateASN1(length(S),S);
-    end
+  L:=Length(Data.Value);
+  if (L<>0) then
+    Result:=UseCertificateASN1(length(Data.Value),Data.Value)
   else if (Data.FileName<>'') then
     begin
-    S:=Data.FileName;
-    Result:=UseCertificateChainFile(PChar(S));
+    FN:=Data.FileName;
+    Result:=UseCertificateChainFile(PChar(FN));
     if Result<>1 then
        begin
-       Result:=UseCertificateFile(S,SSL_FILETYPE_PEM);
-       if Result<>1 then
-         Result:=UseCertificateFile(S,SSL_FILETYPE_ASN1);
+       Result:=UseCertificateFile(FN,SSL_FILETYPE_PEM);
+       if (Result<>1) then
+         Result:=UseCertificateFile(FN,SSL_FILETYPE_ASN1);
        end;
     end
 end;
@@ -292,6 +431,11 @@ begin
   Result:=sslctxUseCertificateASN1(FCTX,len,d);
 end;
 
+function TSSLContext.UseCertificateASN1(len: cLong; buf: TBytes): cInt;
+begin
+  Result:=sslctxUseCertificateASN1(FCTX,len,Buf);
+end;
+
 function TSSLContext.UseCertificateFile(const Afile: String; Atype: cInt): cInt;
 begin
   Result:=sslctxUseCertificateFile(FCTX,Afile,Atype);
@@ -314,6 +458,17 @@ end;
 
 function TSSLContext.LoadPFX(Const S, APassword: AnsiString): cint;
 
+var
+  Buf : TBytes;
+
+begin
+  SetLength(Buf,Length(S));
+  Move(S[1],Buf[0],Length(S));
+  Result:=LoadPFX(Buf,APAssword);
+end;
+
+function TSSLContext.LoadPFX(const Buf: TBytes; APassword: AnsiString): cint;
+
 var
   b: PBIO;
   p12,c,pk,ca: SslPtr;
@@ -326,50 +481,46 @@ begin
   p12:=Nil;
   b:=BioNew(BioSMem);
   try
-    BioWrite(b,S,Length(S));
+    BioWrite(b,Buf,Length(Buf));
     p12:=d2iPKCS12bio(b,nil);
-  finally
-    BioFreeAll(b);
-  end;
-  if Not Assigned(p12) then
-    Exit;
-  try
-    try
+    if Assigned(p12) then
       if PKCS12parse(p12,APassword,pk,c,ca)>0 then
         begin
         Result:=UseCertificate(c);
         if (Result>0) then
           Result:=UsePrivateKey(pk);
         end;
-    finally
+  finally
+    if pk<>Nil then
       EvpPkeyFree(pk);
+    if c<>nil then
       X509free(c);
-//      SkX509PopFree(ca,_X509Free);
-    end;
-  finally
-    PKCS12free(p12);
+//  SkX509PopFree(ca,_X509Free);
+    if p12<>Nil then
+      PKCS12free(p12);
+    BioFreeAll(b);
   end;
 end;
 
 function TSSLContext.LoadPFX(Data: TSSLData; Const APAssword : Ansistring): cint;
 
 Var
-  S : String;
+  B : TBytes;
 
 begin
   Result:=-1;
   try
-    if (Data.Value<>'') then
-      S:=Data.Value
+    if (Length(Data.Value)<>0) then
+      B:=Data.Value
     else
       With TFileStream.Create(Data.FileName,fmOpenRead or fmShareDenyNone) do
         Try
-          SetLength(S,Size);
-          ReadBuffer(S[1],Size);
+          SetLength(B,Size);
+          ReadBuffer(B[0],Size);
         finally
           Free;
         end;
-    Result:=LoadPFX(s,APassword);
+    Result:=LoadPFX(B,APassword);
   except
     // Silently ignore
     Exit;
@@ -407,27 +558,6 @@ begin
   SslCtxCtrl(FCTX, SSL_CTRL_SET_ECDH_AUTO, larg, nil);
 end;
 
-{ TSSLData }
-
-Function TSSLData.Empty: Boolean;
-begin
-  Result:=(Value='') and (FileName='');
-end;
-
-Procedure TSSLData.Assign(Source: TPersistent);
-
-
-begin
-  if Source is TSSLData then
-   With TSSLData(Source) do
-    begin
-    Self.FValue:=FValue;
-    Self.FFileName:=FFileName;
-    end
-  else
-    inherited Assign(Source);
-end;
-
 { TSSL }
 
 Constructor TSSL.Create(ASSL: PSSL);
@@ -473,7 +603,11 @@ end;
 
 function TSSL.Shutdown: cInt;
 begin
-  Result:=sslShutDown(fSSL);
+  try
+    Result:=sslShutDown(fSSL);
+  except
+    // Sometimes, SSL gives an error when the connection is lost
+  end;
 end;
 
 function TSSL.Read(buf: SslPtr; num: cInt): cInt;
@@ -555,6 +689,7 @@ var
 
 begin
   Result:='';
+  S:='';
   c:=PeerCertificate;
   if Assigned(c) then
     try

packages/openssl/src/openssl.pas

@@ -254,6 +254,10 @@ type
   PASN1_cInt = SslPtr;
   PPasswdCb = SslPtr;
   PCallbackCb = SslPtr;
+
+  PX509_STORE_CTX = SslPtr;
+  TSSLCTXVerifyCallback = function (ok : cInt; ctx : PX509_STORE_CTX) : Cint; cdecl;
+
   PFunction = procedure;
   DES_cblock = array[0..7] of Byte;
   PDES_cblock = ^DES_cblock;
@@ -833,6 +837,35 @@ const
   RSA_NO_PADDING         = 3;
   RSA_PKCS1_OAEP_PADDING = 4;
 
+  // ASN1 values
+  V_ASN1_EOC                     = 0;
+  V_ASN1_BOOLEAN                 = 1;
+  V_ASN1_INTEGER                 = 2;
+  V_ASN1_BIT_STRING              = 3;
+  V_ASN1_OCTET_STRING            = 4;
+  V_ASN1_NULL                    = 5;
+  V_ASN1_OBJECT                  = 6;
+  V_ASN1_OBJECT_DESCRIPTOR       = 7;
+  V_ASN1_EXTERNAL                = 8;
+  V_ASN1_REAL                    = 9;
+  V_ASN1_ENUMERATED              = 10;
+  V_ASN1_UTF8STRING              = 12;
+  V_ASN1_SEQUENCE                = 16;
+  V_ASN1_SET                     = 17;
+  V_ASN1_NUMERICSTRING           = 18;
+  V_ASN1_PRINTABLESTRING         = 19;
+  V_ASN1_T61STRING               = 20;
+  V_ASN1_TELETEXSTRING           = 20;
+  V_ASN1_VIDEOTEXSTRING          = 21;
+  V_ASN1_IA5STRING               = 22;
+  V_ASN1_UTCTIME                 = 23;
+  V_ASN1_GENERALIZEDTIME         = 24;
+  V_ASN1_GRAPHICSTRING           = 25;
+  V_ASN1_ISO64STRING             = 26;
+  V_ASN1_VISIBLESTRING           = 26;
+  V_ASN1_GENERALSTRING           = 27;
+  V_ASN1_UNIVERSALSTRING         = 28;
+  V_ASN1_BMPSTRING               = 30;
 
   // BN
 {$ifdef cpu64}
@@ -1016,11 +1049,13 @@ var
   function SslMethodV23:PSSL_METHOD;
   function SslTLSMethod:PSSL_METHOD;
   function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):cInt;
-  function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; d: String; len: cLong):cInt;
+  function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; d: String; len: cLong):cInt;overload;
+  function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; b: TBytes; len: cLong):cInt;overload;
 //  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: cInt):cInt;
   function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
   function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):cInt;
-  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: cLong; d: String):cInt;
+  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: cLong; d: String):cInt; overload;
+  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: cLong; Buf: TBytes):cInt; overload;
   function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
 //  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):cInt;
   function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):cInt;
@@ -1040,7 +1075,7 @@ var
   function SslPending(ssl: PSSL):cInt;
   function SslGetVersion(ssl: PSSL):String;
   function SslGetPeerCertificate(ssl: PSSL):PX509;
-  procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: cInt; arg2: PFunction);
+  procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: cInt; arg2: TSSLCTXVerifyCallback);
   function SSLGetCurrentCipher(s: PSSL):SslPtr;
   function SSLCipherGetName(c: SslPtr): String;
   function SSLCipherGetBits(c: SslPtr; var alg_bits: cInt):cInt;
@@ -1086,6 +1121,9 @@ var
   function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
   function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
   procedure PKCS12free(p12: SslPtr);
+  function Asn1StringTypeNew(aType : cint): PASN1_STRING;
+  Function Asn1UtctimePrint(b : PBio; a: PASN1_UTCTIME) : integer;
+  Function ASN1UtcTimeSetString(t : PASN1_UTCTIME; s : PAnsichar) : cint;
   function Asn1UtctimeNew: PASN1_UTCTIME;
   procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
   function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
@@ -1243,14 +1281,17 @@ var
                u: pointer): integer;	
   function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
   function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
-  
+  function PEM_write_bio_X509(bp: pBIO;  x: px509): integer;
+
   // BIO Functions - bio.h
   function BioNew(b: PBIO_METHOD): PBIO;
   procedure BioFreeAll(b: PBIO);
   function BioSMem: PBIO_METHOD;
   function BioCtrlPending(b: PBIO): cInt;
   function BioRead(b: PBIO; var Buf: String; Len: cInt): cInt;
-  function BioWrite(b: PBIO; Buf: String; Len: cInt): cInt;
+  function BioRead(b: PBIO; Buf: TBytes; Len: cInt): cInt;
+  function BioWrite(b: PBIO; Buf: String; Len: cInt): cInt; overload;
+  function BioWrite(b: PBIO; Buf: TBytes; Len: cInt): cInt; overload;
   function BIO_ctrl(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong;
   function BIO_read_filename(b: PBIO; const name: PChar): cint;
   
@@ -1558,7 +1599,9 @@ type
   Td2iPKCS12bio = function(b:PBIO; Pkcs12: SslPtr): SslPtr; cdecl;
   TPKCS12parse = function(p12: SslPtr; pass: PChar; var pkey, cert, ca: SslPtr): cInt; cdecl;
   TPKCS12free = procedure(p12: SslPtr); cdecl;
-  TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
+  TAsn1StringTypeNew = function(aype : cint): SSlPtr; cdecl;
+  TAsn1UtcTimeSetString = function(t : PASN1_UTCTIME; S : PAnsiChar): cint; cdecl;
+  TAsn1UtctimePrint = Function(b : PBio;a: PASN1_UTCTIME) : cint; cdecl;
   TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
   TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl;
   TAsn1IntegerGet = function(a: PASN1_INTEGER): integer; cdecl;
@@ -1684,6 +1727,7 @@ type
                u: pointer): integer; cdecl;	
   TPEM_write_bio_PUBKEY = function(bp: pBIO; x: pEVP_PKEY): integer; cdecl;
   TPEM_read_bio_X509 = function(bp: pBIO; x: PPX509; cb: Ppem_password_cb; u: pointer): px509; cdecl;
+  TPEM_write_bio_X509 = function(bp: pBIO; x: PX509): integer; cdecl;
 
   // BIO Functions
 
@@ -1783,7 +1827,9 @@ var
   _d2iPKCS12bio: Td2iPKCS12bio = nil;
   _PKCS12parse: TPKCS12parse = nil;
   _PKCS12free: TPKCS12free = nil;
-  _Asn1UtctimeNew: TAsn1UtctimeNew = nil;
+  _Asn1StringTypeNew: TAsn1StringTypeNew = nil;
+  _Asn1UtctimeSetString : TAsn1UtctimeSetString = Nil;
+  _Asn1UtctimePrint: TAsn1UtctimePrint = nil;
   _Asn1UtctimeFree: TAsn1UtctimeFree = nil;
   _Asn1IntegerSet: TAsn1IntegerSet = nil;
   _Asn1IntegerGet: TAsn1IntegerGet = nil;
@@ -1916,6 +1962,7 @@ var
   _PEM_write_bio_PrivateKey: TPEM_write_bio_PrivateKey = nil;	
   _PEM_write_bio_PUBKEY: TPEM_write_bio_PUBKEY = nil;
   _PEM_read_bio_X509: TPEM_read_bio_X509 = nil;
+  _PEM_write_bio_X509: TPEM_write_bio_X509 = nil;
   // BIO Functions
 
   _BIO_ctrl: TBIO_ctrl = nil;
@@ -2200,7 +2247,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; d: String; len: cLong):cInt;
+function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; d: String; len: cLong):cInt; overload;
 begin
   if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then
     Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(d), len)
@@ -2208,6 +2255,14 @@ begin
     Result := 0;
 end;
 
+function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; b: TBytes; len: cLong): cInt;overload;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then
+    Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(b), len)
+  else
+    Result := 0;
+end;
+
 function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyFile) then
@@ -2232,6 +2287,14 @@ begin
     Result := 0;
 end;
 
+function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: cLong; Buf: TBytes): cInt;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificateASN1) then
+    Result := _SslCtxUseCertificateASN1(ctx, len, SslPtr(Buf))
+  else
+    Result := 0;
+end;
+
 function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUseCertificateFile) then
@@ -2363,7 +2426,7 @@ begin
     Result := nil;
 end;
 
-procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: cInt; arg2: PFunction);
+procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: cInt; arg2: TSSLCTXVerifyCallback);
 begin
   if InitSSLInterface and Assigned(_SslCtxSetVerify) then
     _SslCtxSetVerify(ctx, mode, @arg2);
@@ -2587,6 +2650,14 @@ begin
     Result := 0;
 end;
 
+function BioRead(b: PBIO; Buf: TBytes; Len: cInt): cInt;
+begin
+  if InitSSLInterface and Assigned(_BioRead) then
+    Result := _BioRead(b, PChar(Buf), Len)
+  else
+    Result := -2;
+end;
+
 function BioRead(b: PBIO; var Buf: String; Len: cInt): cInt;
 begin
   if InitSSLInterface and Assigned(_BioRead) then
@@ -2604,6 +2675,16 @@ begin
     Result := -2;
 end;
 
+function BioWrite(b: PBIO; Buf: TBytes; Len: cInt): cInt;
+
+begin
+  if InitSSLInterface and Assigned(_BioWrite) then
+    Result := _BioWrite(b, PChar(Buf), Len)
+  else
+    Result := -2;
+end;
+
+
 function X509print(b: PBIO; a: PX509): cInt;
 begin
   if InitSSLInterface and Assigned(_X509print) then
@@ -2694,8 +2775,14 @@ end;
 
 function Asn1UtctimeNew: PASN1_UTCTIME;
 begin
-  if InitSSLInterface and Assigned(_Asn1UtctimeNew) then
-    Result := _Asn1UtctimeNew
+  Result:=PASN1_UTCTIME(Asn1StringTypeNew(V_ASN1_UTCTIME));
+end;
+
+function Asn1StringTypeNew(aType : cint): PASN1_STRING;
+
+begin
+  if InitSSLInterface and Assigned(_Asn1StringTypeNew) then
+    Result := _Asn1StringTypeNew(aType)
   else
     Result := nil;
 end;
@@ -2706,6 +2793,22 @@ begin
     _Asn1UtctimeFree(a);
 end;
 
+function Asn1UtctimePrint(b: PBio; a: PASN1_UTCTIME): integer;
+begin
+  if InitSSLInterface and Assigned(_Asn1UtctimePrint) then
+    Result:=_Asn1UtctimePrint(b,a)
+  else
+    Result:=0;
+end;
+
+function ASN1UtcTimeSetString(t: PASN1_UTCTIME; s: PAnsichar): cint;
+begin
+  if InitSSLInterface and Assigned(_Asn1UtctimeSetString) then
+    Result:=_Asn1UtctimeSetString(t,s)
+  else
+    Result:=0;
+end;
+
 function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
 begin
   if InitSSLInterface and Assigned(_Asn1IntegerSet) then
@@ -3558,7 +3661,7 @@ Begin
     Result := -1;
 end; 
 
-function PEM_read_bio_X509(bp: pBIO;  x: ppx509; cb: Ppem_password_cb; u: pointer): px509;
+function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
 begin
   if InitSSLInterface and Assigned(_PEM_read_bio_X509) then
     Result := _PEM_read_bio_X509(bp, x, cb, u)
@@ -3566,6 +3669,14 @@ begin
     Result := nil;
 end;
 
+function PEM_write_bio_X509(bp: pBIO;  x: px509): integer;
+begin
+  if InitSSLInterface and Assigned(_PEM_write_bio_X509) then
+    Result := _PEM_write_bio_X509(bp, x)
+  else
+    Result := 0;
+end;
+
 
 // BIO Functions
 
@@ -3582,7 +3693,7 @@ begin
   Result := BIO_ctrl(b, BIO_C_SET_FILENAME, BIO_CLOSE or BIO_FP_READ, name);
 end;
 
-function BIO_s_file: PBIO_METHOD;
+function BIO_s_file: pBIO_METHOD;
 begin
   if InitSSLInterface and Assigned(_BIO_s_file) then
     Result := _BIO_s_file
@@ -4643,7 +4754,9 @@ begin
   _d2iPKCS12bio := GetProcAddr(SSLUtilHandle, 'd2i_PKCS12_bio');
   _PKCS12parse := GetProcAddr(SSLUtilHandle, 'PKCS12_parse');
   _PKCS12free := GetProcAddr(SSLUtilHandle, 'PKCS12_free');
-  _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new');
+  _Asn1UtctimeSetString := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_set_string');
+  _Asn1StringTypeNew := GetProcAddr(SSLUtilHandle, 'ASN1_STRING_type_new');
+  _Asn1UtctimePrint := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_print');
   _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free');
   _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set');
   _Asn1IntegerGet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_get');
@@ -4755,7 +4868,8 @@ begin
   _PEM_write_bio_PrivateKey := GetProcAddr(SSLUtilHandle, 'PEM_write_bio_PrivateKey');
   _PEM_write_bio_PUBKEY := GetProcAddr(SSLUtilHandle, 'PEM_write_bio_PUBKEY');
   _PEM_read_bio_X509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509');
-  
+  _PEM_write_bio_X509 := GetProcAddr(SSLUtilHandle,'PEM_write_bio_X509');
+
   // BIO
   _BIO_ctrl := GetProcAddr(SSLUtilHandle, 'BIO_ctrl');
   _BIO_s_file := GetProcAddr(SSLUtilHandle, 'BIO_s_file');
@@ -5105,7 +5219,9 @@ begin
   _d2iPKCS12bio := nil;
   _PKCS12parse := nil;
   _PKCS12free := nil;
-  _Asn1UtctimeNew := nil;
+  _Asn1UtctimeSetString := nil;
+  _Asn1StringTypeNew := nil;
+  _Asn1UtctimePrint := nil;
   _Asn1UtctimeFree := nil;
   _Asn1IntegerSet:= nil;
   _Asn1IntegerGet:= nil;
@@ -5216,6 +5332,7 @@ begin
   _PEM_read_bio_PUBKEY := nil;
   _PEM_write_bio_PrivateKey := nil;
   _PEM_read_bio_X509 := nil;
+  _PEM_write_bio_X509 := nil;
 
   // BIO
 

packages/openssl/src/opensslsockets.pp

@@ -0,0 +1,321 @@
+unit opensslsockets;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sockets, ssockets, sslsockets, sslbase, openssl, fpopenssl;
+
+Type
+
+  { TOpenSSLSocketHandler }
+
+  TOpenSSLSocketHandler = Class(TSSLSocketHandler)
+  Private
+    FSSL: TSSL;
+    FCTX : TSSLContext;
+    FSSLLastErrorString: string;
+    FSSLLastError : Integer;
+  Protected
+    procedure SetSSLLastErrorString(AValue: string);
+    Function FetchErrorInfo: Boolean;
+    function CheckSSL(SSLResult: Integer): Boolean;
+    function CheckSSL(SSLResult: Pointer): Boolean;
+    function InitContext(NeedCertificate: Boolean): Boolean; virtual;
+    function DoneContext: Boolean; virtual;
+    function InitSslKeys: boolean;virtual;
+  Public
+    Constructor create; override;
+    destructor destroy; override;
+    function CreateCertGenerator: TX509Certificate; override;
+    function Connect : Boolean; override;
+    function Close : Boolean; override;
+    function Accept : Boolean; override;
+    function Shutdown(BiDirectional : Boolean): boolean; override;
+    function Send(Const Buffer; Count: Integer): Integer; override;
+    function Recv(Const Buffer; Count: Integer): Integer; override;
+    function BytesAvailable: Integer; override;
+    // Result of last CheckSSL call.
+    Function SSLLastError: integer;
+    property SSLLastErrorString: string read FSSLLastErrorString write SetSSLLastErrorString;
+  end;
+
+implementation
+
+{ TSocketHandler }
+Resourcestring
+  SErrNoLibraryInit = 'Could not initialize OpenSSL library';
+
+Procedure MaybeInitSSLInterface;
+
+begin
+  if not IsSSLloaded then
+    if not InitSSLInterface then
+      Raise EInOutError.Create(SErrNoLibraryInit);
+end;
+
+function TopenSSLSocketHandler.CreateCertGenerator: TX509Certificate;
+begin
+  Result:=TOpenSSLX509Certificate.Create;
+end;
+
+procedure TOpenSSLSocketHandler.SetSSLLastErrorString(AValue: string);
+begin
+  if FSSLLastErrorString=AValue then Exit;
+  FSSLLastErrorString:=AValue;
+end;
+
+function TOpenSSLSocketHandler.Connect: Boolean;
+begin
+  Result:=Inherited Connect;
+  Result := Result and InitContext(False);
+  if Result then
+    begin
+    Result:=CheckSSL(FSSL.SetFD(Socket.Handle));
+    if Result then
+     begin
+     if SendHostAsSNI  and (Socket is TInetSocket) then
+       FSSL.Ctrl(SSL_CTRL_SET_TLSEXT_HOSTNAME,TLSEXT_NAMETYPE_host_name,PAnsiChar(AnsiString((Socket as TInetSocket).Host)));
+     Result:=CheckSSL(FSSL.Connect);
+     if Result and VerifyPeerCert then
+       Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);
+     if Result then
+       SetSSLActive(True);
+     end;
+    end;
+end;
+
+function TOpenSSLSocketHandler.Close: Boolean;
+begin
+  Result:=Shutdown(False);
+end;
+
+Function TOpenSSLSocketHandler.FetchErrorInfo : Boolean;
+
+var
+  S : AnsiString;
+
+begin
+  FSSLLastErrorString:='';
+  FSSLLastError:=ErrGetError;
+  ErrClearError;
+  Result:=(FSSLLastError<>0);
+  if Result then
+    begin
+    S:=StringOfChar(#0,256);
+    ErrErrorString(FSSLLastError,S,256);
+    FSSLLastErrorString:=s;
+    end;
+end;
+
+function TOpenSSLSocketHandler.CheckSSL(SSLResult : Integer) : Boolean;
+
+begin
+  Result:=SSLResult>=1;
+  if Not Result then
+     begin
+     FSSLLastError:=SSLResult;
+     FetchErrorInfo;
+     end;
+end;
+
+function TOpenSSLSocketHandler.CheckSSL(SSLResult: Pointer): Boolean;
+begin
+  Result:=(SSLResult<>Nil);
+  if not Result then
+    Result:=FetchErrorInfo;
+end;
+
+function TOpenSSLSocketHandler.DoneContext: Boolean;
+
+begin
+  FreeAndNil(FSSL);
+  FreeAndNil(FCTX);
+  ErrRemoveState(0);
+  SetSSLActive(False);
+  Result:=True;
+end;
+
+Function HandleSSLPwd(buf : PAnsiChar; len:Integer; flags:Integer; UD : Pointer):Integer; cdecl;
+
+var
+  Pwd: AnsiString;
+  H :  TOpenSSLSocketHandler;
+
+begin
+  if Not Assigned(UD) then
+    PWD:=''
+  else
+    begin
+    H:=TOpenSSLSocketHandler(UD);
+    Pwd:=H.CertificateData.KeyPassword;
+    end;
+  if (len<Length(Pwd)+1) then
+    SetLength(Pwd,len-1);
+  pwd:=pwd+#0;
+  Result:=Length(Pwd);
+  Move(Pointer(Pwd)^,Buf^,Result);
+end;
+
+function TOpenSSLSocketHandler.InitSslKeys: boolean;
+
+begin
+  Result:=(FCTX<>Nil);
+  if not Result then
+    Exit;
+  if not CertificateData.Certificate.Empty then
+    Result:=CheckSSL(FCTX.UseCertificate(CertificateData.Certificate));
+  if Result and not CertificateData.PrivateKey.Empty then
+    Result:=CheckSSL(FCTX.UsePrivateKey(CertificateData.PrivateKey));
+  if Result and (CertificateData.CertCA.FileName<>'') then
+    Result:=CheckSSL(FCTX.LoadVerifyLocations(CertificateData.CertCA.FileName,''));
+  if Result and not CertificateData.PFX.Empty then
+    Result:=CheckSSL(FCTX.LoadPFX(CertificateData.PFX,CertificateData.KeyPassword));
+end;
+
+constructor TOpenSSLSocketHandler.create;
+begin
+  inherited create;
+  MaybeInitSSLInterface;
+end;
+
+destructor TOpenSSLSocketHandler.destroy;
+begin
+  FreeAndNil(FCTX);
+  FreeAndNil(FSSL);
+  inherited destroy;
+end;
+
+function TOpenSSLSocketHandler.InitContext(NeedCertificate:Boolean): Boolean;
+
+Const
+  VO : Array[Boolean] of Integer = (SSL_VERIFY_NONE,SSL_VERIFY_PEER);
+
+var
+  s: AnsiString;
+
+begin
+  Result:=DoneContext;
+  if Not Result then
+    Exit;
+  try
+    FCTX:=TSSLContext.Create(SSLType);
+  Except
+    CheckSSL(Nil);
+    Result:=False;
+    Exit;
+  end;
+  S:=CertificateData.CipherList;
+  FCTX.SetCipherList(S);
+  FCTX.SetVerify(VO[VerifypeerCert],Nil);
+  FCTX.SetDefaultPasswdCb(@HandleSSLPwd);
+  FCTX.SetDefaultPasswdCbUserdata(self);
+  If NeedCertificate and CertificateData.NeedCertificateData  then
+    if Not CreateSelfSignedCertificate then
+      begin
+      DoneContext;
+      Exit(False);
+      end;
+   if Not InitSSLKeys then
+     begin
+     DoneContext;
+     Exit(False);
+     end;
+   try
+     FSSL:=TSSL.Create(FCTX);
+     Result:=True;
+   Except
+     CheckSSL(Nil);
+     DoneContext;
+     Result:=False;
+   end;
+end;
+
+function TOpenSSLSocketHandler.Accept: Boolean;
+
+begin
+  Result:=InitContext(True);
+  if Result then
+    begin
+    Result:=CheckSSL(FSSL.setfd(Socket.Handle));
+    if Result then
+      Result:=CheckSSL(FSSL.Accept);
+    end;
+  SetSSLActive(Result);
+end;
+
+
+function TOpenSSLSocketHandler.Shutdown(BiDirectional : Boolean): boolean;
+
+var
+  r : integer;
+
+begin
+  Result:=assigned(FSsl);
+  if Result then
+    If Not BiDirectional then
+      Result:=CheckSSL(FSSL.Shutdown)
+    else
+      begin
+      r:=FSSL.Shutdown;
+      if r<>0 then
+        Result:=CheckSSL(r)
+      else
+        begin
+        Result:=fpShutdown(Socket.Handle,1)=0;
+        if Result then
+          Result:=CheckSSL(FSsl.Shutdown);
+        end
+      end;
+  If Result then
+    Result:=DoneContext;
+end;
+
+function TOpenSSLSocketHandler.Send(Const Buffer; Count: Integer): Integer;
+var
+  e: integer;
+begin
+  FSSLLastError := 0;
+  FSSLLastErrorString:='';
+  repeat
+    Result:=FSsl.Write(@Buffer,Count);
+    e:=FSsl.GetError(Result);
+  until Not (e in [SSL_ERROR_WANT_READ,SSL_ERROR_WANT_WRITE]);
+  if (E=SSL_ERROR_ZERO_RETURN) then
+    Result:=0
+  else if (e<>0) then
+    FSSLLastError:=e;
+end;
+
+function TOpenSSLSocketHandler.Recv(Const Buffer; Count: Integer): Integer;
+
+var
+  e: integer;
+begin
+  FSSLLastError:=0;
+  FSSLLastErrorString:= '';
+  repeat
+    Result:=FSSL.Read(@Buffer ,Count);
+    e:=FSSL.GetError(Result);
+  until Not (e in [SSL_ERROR_WANT_READ,SSL_ERROR_WANT_WRITE]);
+  if (E=SSL_ERROR_ZERO_RETURN) then
+    Result:=0
+  else if (e<>0) then
+    FSSLLastError:=e;
+end;
+
+function TOpenSSLSocketHandler.BytesAvailable: Integer;
+begin
+  Result:= FSSL.Pending;
+end;
+
+Function TOpenSSLSocketHandler.SSLLastError: integer;
+begin
+  Result:=FSSLLastError;
+end;
+
+initialization
+  TSSLSocketHandler.SetDefaultHandlerClass(TOpenSSLSocketHandler);
+end.
+