فهرست منبع

Propagate SSL initialization errors as exceptions

Ondrej Pokorny 4 سال پیش
والد
کامیت
400e11e6cf
2فایلهای تغییر یافته به همراه29 افزوده شده و 12 حذف شده
  1. 16 6
      packages/fcl-net/src/ssockets.pp
  2. 13 6
      packages/openssl/src/opensslsockets.pp

+ 16 - 6
packages/fcl-net/src/ssockets.pp

@@ -879,20 +879,30 @@ begin
 end;
 end;
 
 
 Function  TInetServer.SockToStream (ASocket : Longint) : TSocketStream;
 Function  TInetServer.SockToStream (ASocket : Longint) : TSocketStream;
-
 Var
 Var
   H : TSocketHandler;
   H : TSocketHandler;
+  A : Boolean;
+
+  procedure ShutDownH;
+  begin
+    H.Shutdown(False);
+    FreeAndNil(Result);
+  end;
 
 
 begin
 begin
   H:=GetClientSocketHandler(aSocket);
   H:=GetClientSocketHandler(aSocket);
   Result:=TInetSocket.Create(ASocket,H);
   Result:=TInetSocket.Create(ASocket,H);
   (Result as TInetSocket).FHost:='';
   (Result as TInetSocket).FHost:='';
   (Result as TInetSocket).FPort:=FPort;
   (Result as TInetSocket).FPort:=FPort;
-  if Not H.Accept then
-    begin
-    H.Shutdown(False);
-    FreeAndNil(Result);
-    end;
+
+  try
+    A:=H.Accept;
+  except
+    ShutDownH;
+    raise;
+  end;
+  if Not A then
+    ShutDownH;
 end;
 end;
 
 
 Function TInetServer.Accept : Longint;
 Function TInetServer.Accept : Longint;

+ 13 - 6
packages/openssl/src/opensslsockets.pp

@@ -22,6 +22,7 @@ Type
     Function FetchErrorInfo: Boolean;
     Function FetchErrorInfo: Boolean;
     function CheckSSL(SSLResult: Integer): Boolean;
     function CheckSSL(SSLResult: Integer): Boolean;
     function CheckSSL(SSLResult: Pointer): Boolean;
     function CheckSSL(SSLResult: Pointer): Boolean;
+    function CreateSSLContext(AType: TSSLType): TSSLContext; virtual;
     function InitContext(NeedCertificate: Boolean): Boolean; virtual;
     function InitContext(NeedCertificate: Boolean): Boolean; virtual;
     function DoneContext: Boolean; virtual;
     function DoneContext: Boolean; virtual;
     function InitSslKeys: boolean;virtual;
     function InitSslKeys: boolean;virtual;
@@ -49,6 +50,8 @@ implementation
 { TSocketHandler }
 { TSocketHandler }
 Resourcestring
 Resourcestring
   SErrNoLibraryInit = 'Could not initialize OpenSSL library';
   SErrNoLibraryInit = 'Could not initialize OpenSSL library';
+  SErrCouldNotCreateSelfSignedCertificate = 'Failed to create self-signed certificate';
+  SErrCouldNotInitSSLKeys = 'Failed to initialize SSL keys';
 
 
 Procedure MaybeInitSSLInterface;
 Procedure MaybeInitSSLInterface;
 
 
@@ -63,6 +66,11 @@ begin
   Result:=TOpenSSLX509Certificate.Create;
   Result:=TOpenSSLX509Certificate.Create;
 end;
 end;
 
 
+function TOpenSSLSocketHandler.CreateSSLContext(AType: TSSLType): TSSLContext;
+begin
+  Result := TSSLContext.Create(AType);
+end;
+
 procedure TOpenSSLSocketHandler.SetSSLLastErrorString(AValue: string);
 procedure TOpenSSLSocketHandler.SetSSLLastErrorString(AValue: string);
 begin
 begin
   if FSSLLastErrorString=AValue then Exit;
   if FSSLLastErrorString=AValue then Exit;
@@ -215,11 +223,10 @@ begin
   if Not Result then
   if Not Result then
     Exit;
     Exit;
   try
   try
-    FCTX:=TSSLContext.Create(SSLType);
+    FCTX:=CreateSSLContext(SSLType);
   Except
   Except
     CheckSSL(Nil);
     CheckSSL(Nil);
-    Result:=False;
-    Exit;
+    raise;
   end;
   end;
   S:=CertificateData.CipherList;
   S:=CertificateData.CipherList;
   FCTX.SetCipherList(S);
   FCTX.SetCipherList(S);
@@ -230,12 +237,12 @@ begin
     if Not CreateSelfSignedCertificate then
     if Not CreateSelfSignedCertificate then
       begin
       begin
       DoneContext;
       DoneContext;
-      Exit(False);
+      raise ESSL.Create(SErrCouldNotCreateSelfSignedCertificate);
       end;
       end;
    if Not InitSSLKeys then
    if Not InitSSLKeys then
      begin
      begin
      DoneContext;
      DoneContext;
-     Exit(False);
+     raise ESSL.Create(SErrCouldNotInitSSLKeys);
      end;
      end;
    try
    try
      FSSL:=TSSL.Create(FCTX);
      FSSL:=TSSL.Create(FCTX);
@@ -243,7 +250,7 @@ begin
    Except
    Except
      CheckSSL(Nil);
      CheckSSL(Nil);
      DoneContext;
      DoneContext;
-     Result:=False;
+     raise;
    end;
    end;
 end;
 end;