* Added initial secure sockets support

git-svn-id: trunk@27526 -

.gitattributes

@@ -2448,6 +2448,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/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
 packages/fcl-net/src/win/resolve.inc svneol=native#text/plain

packages/fcl-net/fpmake.pp

@@ -18,6 +18,7 @@ begin
 {$endif ALLPACKAGES}
     P.Version:='2.7.1';
     P.Dependencies.Add('fcl-base');
+    P.Dependencies.Add('openssl');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-passrc');
     P.Dependencies.Add('fcl-async',[linux,freebsd,netbsd,openbsd]);
@@ -52,6 +53,12 @@ begin
           AddUnit('resolve');
         end;
     T.ResourceStrings := True;
+    T:=P.Targets.AddUnit('sslsockets.pp',AllUnixOSes+AllWindowsOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('ssockets');
+        end;
+    T.ResourceStrings := True;
 
     // HTTP Client
     T:=P.Targets.AddUnit('fpsock.pp',[linux,freebsd,netbsd,openbsd]);

packages/fcl-net/src/sslsockets.pp

@@ -0,0 +1,446 @@
+unit sslsockets;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sockets, ssockets, openssl, fpopenssl;
+
+Const
+  SSLDataCount = 4; // 0 based.
+
+Type
+  TVerifyCertificateEvent = Procedure(Sender : TObject; Allow : Boolean) of object;
+  { TSSLSocketHandler }
+
+  TSSLSocketHandler = class(TSocketHandler)
+  private
+    FRemoteHostName: String;
+    FSSLLastErrorString: string;
+    FCipherList: string;
+    FVerifyPeerCert: Boolean;
+    FOnVerifyCertificate: TVerifyCertificateEvent;
+    FSSLType: TSSLType;
+    FKeyPassword: string;
+    FUsername: string;
+    FPassword: string;
+    FCertData : Array[0..4] of TSSLData;
+    FSSL: TSSL;
+    FCTX : TSSLContext;
+    FSSLActive : Boolean;
+    function CheckSSL(SSLResult: Integer): Boolean;
+    function CheckSSL(SSLResult: Pointer): Boolean;
+    function DoneContext: Boolean;
+    Function FetchErrorInfo: Boolean;
+    function GetSSLData(AIndex: Integer): TSSLData;
+    function InitContext(NeedCertificate: Boolean): Boolean;
+    function InitSslKeys: boolean;
+    procedure SetSSLData(AIndex: Integer; AValue: TSSLData);
+    procedure SetSSLLastErrorString(AValue: string);
+  protected
+    procedure ReturnError;
+    function DoVerifyCert:boolean;
+  public
+    constructor Create; override;
+    Destructor Destroy; override;
+    // 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;
+  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;
+    // 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 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;
+
+
+{ 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;
+
+procedure TSSLSocketHandler.ReturnError;
+begin
+
+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;
+  MaybeInitSSLInterface;
+  FCipherList:='DEFAULT';
+  For I:=0 to SSLDataCount do
+    FCertData[i]:=TSSLData.Create;
+end;
+
+Destructor TSSLSocketHandler.Destroy;
+
+Var
+  I : Integer;
+
+begin
+  inherited Destroy;
+  For I:=0 to SSLDataCount do
+    FreeAndNil(FCertData[i]);
+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;
+
+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);
+  end;
+end;
+
+function TSSLSocketHandler.Connect: Boolean;
+begin
+  Result:=Inherited Connect;
+  if Result and InitContext(False) then
+    begin
+    Result:=CheckSSL(FSSL.SetFD(FSocket.Handle));
+    if Result then
+     begin
+     Result:=CheckSSL(FSSL.Connect);
+     if Result and VerifyPeerCert then
+       Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);
+     if Result then
+       FSSLActive:=True;
+     end;
+    end;
+end;
+
+function TSSLSocketHandler.Close: Boolean;
+begin
+  Result:=Shutdown(False);
+end;
+
+Function TSSLSocketHandler.FetchErrorInfo : Boolean;
+
+var
+  S : AnsiString;
+
+begin
+  FSSLLastErrorString:='';
+  FLastError:=ErrGetError;
+  ErrClearError;
+  Result:=(FLastError>=1);
+  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;
+end;
+
+function TSSLSocketHandler.CheckSSL(SSLResult: Pointer): Boolean;
+begin
+  Result:=(SSLResult<>Nil);
+  if not Result then
+    Result:=FetchErrorInfo;
+end;
+
+function TSSLSocketHandler.DoneContext: Boolean;
+
+begin
+  FreeAndNil(FSSL);
+  FreeAndNil(FCTX);
+  ErrRemoveState(0);
+  FSSLActive:=False;
+  Result:=True;
+end;
+
+Function HandleSSLPwd(buf : PAnsiChar; len:Integer; flags:Integer; UD : Pointer):Integer; cdecl;
+
+var
+  Pwd: AnsiString;
+  H :  TSSLSocketHandler;
+
+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);
+end;
+
+function TSSLSocketHandler.InitSslKeys: boolean;
+
+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));
+end;
+
+function TSSLSocketHandler.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:=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;
+end;
+
+function TSSLSocketHandler.Accept: Boolean;
+
+begin
+  Result:=InitContext(True);
+  if Result then
+    begin
+    Result:=CheckSSL(FSSL.setfd(Socket.Handle));
+    if Result then
+      Result:=CheckSSL(FSSL.Accept);
+    end;
+  FSSLActive:=Result;
+end;
+
+function TSSLSocketHandler.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(FSocket.Handle,1)=0;
+        if Result then
+          Result:=CheckSSL(FSsl.Shutdown);
+        end
+      end;
+  If Result then
+    Result:=DoneContext;
+end;
+
+function TSSLSocketHandler.Send(Const Buffer; Count: Integer): Integer;
+var
+  e: integer;
+begin
+  FLastError := 0;
+  FSSLLastErrorString:='';
+  repeat
+    Writeln(pchar(@buffer));
+    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;
+end;
+
+function TSSLSocketHandler.Recv(Const Buffer; Count: Integer): Integer;
+
+var
+  e: integer;
+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;
+end;
+
+function TSSLSocketHandler.BytesAvailable: Integer;
+begin
+  Result:= FSSL.Pending;
+end;
+
+Function TSSLSocketHandler.SSLActive: Boolean;
+begin
+  Result:=FSSLActive;
+end;
+
+Function TSSLSocketHandler.SSLLastError: integer;
+begin
+  Result:=FLastError;
+end;
+
+end.
+