Browse Source

* Support for content-disposition: attachment

Michaël Van Canneyt 1 year ago
parent
commit
81a1447b54

+ 9 - 0
packages/fcl-web/src/restbridge/sqldbrestado.pp

@@ -85,7 +85,9 @@ Type
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Class Function GetContentType: String; override;
     Class Function GetContentType: String; override;
+    Class function FileExtension : string; override;
     function RequireMetadata : Boolean; override;
     function RequireMetadata : Boolean; override;
+   
     procedure InitStreaming; override;
     procedure InitStreaming; override;
     Property DataName : UTF8String Read FDataName Write FDataName;
     Property DataName : UTF8String Read FDataName Write FDataName;
     Property RowName : UTF8String Read FRowName Write FRowName;
     Property RowName : UTF8String Read FRowName Write FRowName;
@@ -359,6 +361,13 @@ begin
   Result:='text/xml';
   Result:='text/xml';
 end;
 end;
 
 
+Class function TADOOutputStreamer.FileExtension : string; 
+
+begin
+  Result:='.xml';
+end;
+
+
 function TADOOutputStreamer.RequireMetadata: Boolean;
 function TADOOutputStreamer.RequireMetadata: Boolean;
 begin
 begin
   Result:=True;
   Result:=True;

+ 39 - 5
packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -310,6 +310,8 @@ Type
     function ResolvedCORSAllowedOrigins(aRequest: TRequest): String; virtual;
     function ResolvedCORSAllowedOrigins(aRequest: TRequest): String; virtual;
     procedure HandleCORSRequest(aConnection: TSQLDBConnectionDef; IO: TRestIO); virtual;
     procedure HandleCORSRequest(aConnection: TSQLDBConnectionDef; IO: TRestIO); virtual;
     procedure HandleResourceRequest(aConnection : TSQLDBConnectionDef; IO: TRestIO); virtual;
     procedure HandleResourceRequest(aConnection : TSQLDBConnectionDef; IO: TRestIO); virtual;
+    procedure HandleCorsResponseHeaders(IO: TRestIO); virtual;
+    procedure HandleOtherResponseHeaders(IO: TRestIO); virtual;
     procedure DoHandleRequest(IO: TRestIO); virtual;
     procedure DoHandleRequest(IO: TRestIO); virtual;
   Public
   Public
     Class Procedure SetIOClass (aClass: TRestIOClass);
     Class Procedure SetIOClass (aClass: TRestIOClass);
@@ -1937,6 +1939,41 @@ begin
     end;
     end;
 end;
 end;
 
 
+
+procedure TSQLDBRestDispatcher.HandleCorsResponseHeaders(IO : TRestIO);
+
+begin
+  if (rdoHandleCORS in DispatchOptions) then
+    begin
+    IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins(IO.Request));
+    IO.Response.SetCustomHeader('Access-Control-Allow-Credentials',BoolToStr(CORSAllowCredentials,'true','false'));
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.HandleOtherResponseHeaders(IO : TRestIO);
+
+Var
+  Qn,CD : String;
+  HaveHeader : Boolean;
+
+begin
+  QN:=IO.RestStrings.AttachmentParam;
+  With IO.Request.QueryFields do
+    begin
+    HaveHeader:=(IndexOfName(QN)<>-1);
+    Cd:=values[QN];
+    end;
+  if (CD<>'') or HaveHeader then
+    begin
+    If CD='' then
+      begin
+      CD:=IO.ResourceName;
+      CD:=CD+IO.RESTOutput.FileExtension;
+      end;
+    IO.Response.SetCustomHeader('Content-Disposition',Format('attachment; filename="%s"',[CD]));
+    end;
+end;
+
 procedure TSQLDBRestDispatcher.HandleResourceRequest(aConnection : TSQLDBConnectionDef; IO : TRestIO);
 procedure TSQLDBRestDispatcher.HandleResourceRequest(aConnection : TSQLDBConnectionDef; IO : TRestIO);
 
 
 Var
 Var
@@ -1964,15 +2001,12 @@ begin
         Conn.LogEvents:=LogSQLOptions;
         Conn.LogEvents:=LogSQLOptions;
         Conn.OnLog:[email protected];
         Conn.OnLog:[email protected];
         end;
         end;
-      if (rdoHandleCORS in DispatchOptions) then
-        begin
-        IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins(IO.Request));
-        IO.Response.SetCustomHeader('Access-Control-Allow-Credentials',BoolToStr(CORSAllowCredentials,'true','false'));
-        end;
+      HandleCorsResponseHeaders(IO);
       if not AuthenticateRequest(IO,True) then
       if not AuthenticateRequest(IO,True) then
         exit;
         exit;
       if Not CheckResourceAccess(IO) then
       if Not CheckResourceAccess(IO) then
         exit;
         exit;
+      HandleOtherResponseHeaders(IO);
       DoHandleEvent(True,IO);
       DoHandleEvent(True,IO);
       H:=CreateDBHandler(IO);
       H:=CreateDBHandler(IO);
       if IsSpecialResource(IO.Resource) then
       if IsSpecialResource(IO.Resource) then

+ 6 - 0
packages/fcl-web/src/restbridge/sqldbrestcds.pp

@@ -81,6 +81,7 @@ Type
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Class Function GetContentType: String; override;
     Class Function GetContentType: String; override;
+    Class Function FileExtension : String; override;
     procedure InitStreaming; override;
     procedure InitStreaming; override;
   end;
   end;
 
 
@@ -354,6 +355,11 @@ begin
   Result:='text/xml';
   Result:='text/xml';
 end;
 end;
 
 
+class function TCDSOutputStreamer.FileExtension: String;
+begin
+  Result:='xml';
+end;
+
 procedure TCDSOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
 procedure TCDSOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
 
 
 Var
 Var

+ 6 - 0
packages/fcl-web/src/restbridge/sqldbrestcsv.pp

@@ -65,6 +65,7 @@ Type
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Class Function GetContentType: String; override;
     Class Function GetContentType: String; override;
+    Class Function FileExtension : String; override;
     procedure InitStreaming; override;
     procedure InitStreaming; override;
   end;
   end;
 
 
@@ -188,6 +189,11 @@ begin
   Result:='text/csv';
   Result:='text/csv';
 end;
 end;
 
 
+Class Function TCSVOutputStreamer.FileExtension : String; 
+begin
+  Result:='.csv';
+end;
+
 procedure TCSVOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
 procedure TCSVOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
 
 
 Var
 Var

+ 12 - 3
packages/fcl-web/src/restbridge/sqldbrestio.pp

@@ -83,7 +83,8 @@ Type
                          rpXMLDocumentRoot,
                          rpXMLDocumentRoot,
                          rpConnectionResourceName,
                          rpConnectionResourceName,
                          rpParametersResourceName,
                          rpParametersResourceName,
-                         rpParametersRoutePart
+                         rpParametersRoutePart,
+                         rpAttachment
                          );
                          );
   TRestStringProperties = Set of TRestStringProperty;
   TRestStringProperties = Set of TRestStringProperty;
 
 
@@ -144,6 +145,7 @@ Type
     Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property ConnectionResourceName : UTF8string Index ord(rpConnectionResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property ConnectionResourceName : UTF8string Index ord(rpConnectionResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+    Property AttachmentParam : UTF8String Index ord(rpAttachment) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
   end;
   end;
 
 
   TRestStatus = (rsError,                   // Internal logic/unexpected error (500)
   TRestStatus = (rsError,                   // Internal logic/unexpected error (500)
@@ -263,6 +265,7 @@ Type
   Public
   Public
     Class Procedure RegisterStreamer(Const aName : String);
     Class Procedure RegisterStreamer(Const aName : String);
     Class Procedure UnRegisterStreamer(Const aName : String);
     Class Procedure UnRegisterStreamer(Const aName : String);
+    Class Function FileExtension : String; virtual;
     function RequireMetadata : Boolean; virtual;
     function RequireMetadata : Boolean; virtual;
     Function FieldToString(aFieldType : TRestFieldType; F : TField) : UTF8string; virtual;
     Function FieldToString(aFieldType : TRestFieldType; F : TField) : UTF8string; virtual;
     function FieldToBase64(F: TField): UTF8String; virtual;
     function FieldToBase64(F: TField): UTF8String; virtual;
@@ -476,7 +479,8 @@ Const
     'datapacket',      { rpXMLDocumentRoot}
     'datapacket',      { rpXMLDocumentRoot}
     '_connection',     { rpConnectionResourceName }
     '_connection',     { rpConnectionResourceName }
     '_parameters',     { rpParametersResourceName }
     '_parameters',     { rpParametersResourceName }
-    'parameters'       { rpParametersRoutePart }
+    'parameters',      { rpParametersRoutePart }
+    'att'              { rpAttachment }
   );
   );
   DefaultStatuses : Array[TRestStatus] of Word = (
   DefaultStatuses : Array[TRestStatus] of Word = (
     500, { rsError }
     500, { rsError }
@@ -919,11 +923,16 @@ begin
   TStreamerFactory.Instance.RegisterStreamer(rstOutput,aName,Self)
   TStreamerFactory.Instance.RegisterStreamer(rstOutput,aName,Self)
 end;
 end;
 
 
-class procedure TRestOutPutStreamer.UnRegisterStreamer(const aName: String);
+class procedure TRestOutputStreamer.UnRegisterStreamer(const aName: String);
 begin
 begin
   TStreamerFactory.Instance.UnRegisterStreamer(rstOutput,aName)
   TStreamerFactory.Instance.UnRegisterStreamer(rstOutput,aName)
 end;
 end;
 
 
+class function TRestOutputStreamer.FileExtension: String;
+begin
+  Result:='';
+end;
+
 function TRestOutputStreamer.RequireMetadata: Boolean;
 function TRestOutputStreamer.RequireMetadata: Boolean;
 begin
 begin
   Result:=False;
   Result:=False;

+ 6 - 0
packages/fcl-web/src/restbridge/sqldbrestjson.pp

@@ -67,6 +67,7 @@ Type
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Class Function GetContentType: String; override;
     Class Function GetContentType: String; override;
+    Class Function FileExtension : String; override;
     procedure InitStreaming; override;
     procedure InitStreaming; override;
   end;
   end;
 
 
@@ -250,6 +251,11 @@ begin
   Result:='application/json';
   Result:='application/json';
 end;
 end;
 
 
+Class Function TJSONOutputStreamer.FileExtension : String; 
+begin
+  Result:='.json';
+end;
+
 procedure TJSONOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
 procedure TJSONOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
 
 
 Var
 Var

+ 7 - 0
packages/fcl-web/src/restbridge/sqldbrestxml.pp

@@ -77,6 +77,7 @@ Type
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Class Function GetContentType: String; override;
     Class Function GetContentType: String; override;
+    Class Function FileExtension: String; override;
     procedure InitStreaming; override;
     procedure InitStreaming; override;
   end;
   end;
 
 
@@ -101,6 +102,12 @@ begin
   Result:='text/xml';
   Result:='text/xml';
 end;
 end;
 
 
+Class Function TXMLOutputStreamer.FileExtension: String;
+begin
+  Result:='.xml';  
+end;
+
+
 function TXMLInputStreamer.SelectObject(aIndex: Integer): Boolean;
 function TXMLInputStreamer.SelectObject(aIndex: Integer): Boolean;
 
 
 Var
 Var