From eb6922b42999f497ac79d0791a44900fb85531c2 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Thu, 27 Jun 2019 11:33:26 +0000
Subject: [PATCH] * Better CORS handling: return origin if available and
 allowed domains not set (* will prohibit credentials)

git-svn-id: trunk@42295 -
---
 .../fcl-web/src/restbridge/sqldbrestbridge.pp | 20 ++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

diff --git a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
index 494db564bb..03c355cca9 100644
--- a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
+++ b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
@@ -308,7 +308,7 @@ Type
     // General HTTP handling
     procedure DoRegisterRoutes; virtual;
     procedure DoHandleEvent(IsBefore : Boolean;IO: TRestIO); virtual;
-    function ResolvedCORSAllowedOrigins: String; virtual;
+    function ResolvedCORSAllowedOrigins(aRequest: TRequest): String; virtual;
     procedure HandleCORSRequest(aConnection: TSQLDBRestConnection; IO: TRestIO); virtual;
     procedure HandleResourceRequest(aConnection : TSQLDBRestConnection; IO: TRestIO); virtual;
     procedure DoHandleRequest(IO: TRestIO); virtual;
@@ -410,7 +410,7 @@ Const
 
 implementation
 
-uses fpjsonrtti, DateUtils, bufdataset, sqldbrestjson, sqldbrestconst;
+uses uriparser, fpjsonrtti, DateUtils, bufdataset, sqldbrestjson, sqldbrestconst;
 
 Type
 
@@ -1625,10 +1625,24 @@ begin
     end
 end;
 
-function TSQLDBRestDispatcher.ResolvedCORSAllowedOrigins: String;
+function TSQLDBRestDispatcher.ResolvedCORSAllowedOrigins(aRequest : TRequest): String;
+
+Var
+  URl : String;
 
 begin
   Result:=FCORSAllowedOrigins;
+  if Result='' then
+    begin
+    // Sent with CORS request
+    URL:=aRequest.GetCustomHeader('Origin');
+    // Fallback
+    if URL='' then
+      URL:=aRequest.Referer;
+    // Extract hostname
+    if (URL<>'') then
+      Result:=ParseURI(URL).Host;
+    end;
   if Result='' then
      Result:='*';
 end;