mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 09:28:19 +02:00
* Merging revisions r45421,r45422 from trunk:
------------------------------------------------------------------------
r45421 | michael | 2020-05-18 17:07:13 +0200 (Mon, 18 May 2020) | 1 line
* Patch from Fabio Girardi to support ifNoneChanged header using enumerated
------------------------------------------------------------------------
r45422 | michael | 2020-05-18 17:08:49 +0200 (Mon, 18 May 2020) | 1 line
* Support generating API
------------------------------------------------------------------------
git-svn-id: branches/fixes_3_2@46584 -
This commit is contained in:
michael
parent
531d936247
commit
e19ca5dac8
@ -89,7 +89,7 @@ const
|
||||
FieldCookie = HeaderCookie deprecated;
|
||||
FieldSetCookie = HeaderSetCookie deprecated;
|
||||
|
||||
NoHTTPFields = 27;
|
||||
NoHTTPFields = 28;
|
||||
|
||||
HTTPDateFmt = httpProtocol.HTTPDateFmt;
|
||||
SCookieExpire = httpProtocol.SCookieExpire;
|
||||
@ -129,7 +129,7 @@ Const
|
||||
fieldFrom, fieldIfModifiedSince, fieldLastModified, fieldLocation,
|
||||
fieldPragma, fieldReferer, fieldRetryAfter, fieldServer,
|
||||
fieldSetCookie, fieldUserAgent, fieldWWWAuthenticate,
|
||||
fieldHost, fieldCacheControl,fieldXRequestedWith) deprecated;
|
||||
fieldHost, fieldCacheControl,fieldXRequestedWith,fieldIfNoneMatch) deprecated;
|
||||
|
||||
// Map header names on indexes in property getter/setter. 0 means not mapped !
|
||||
HTTPFieldIndexes : THTTPIndexes
|
||||
@ -140,7 +140,7 @@ Const
|
||||
14,15,16,17,
|
||||
18,19,20,21,
|
||||
22,23,24,
|
||||
34,0,36) deprecated;
|
||||
34,0,36,26) deprecated;
|
||||
|
||||
|
||||
|
||||
@ -553,6 +553,8 @@ type
|
||||
Procedure RemoveVariable(VariableName : String); virtual; abstract;
|
||||
// Terminate session
|
||||
Procedure Terminate; virtual; abstract;
|
||||
// checks if session variable exists
|
||||
Function SessionVariableExists(VarName : String) : Boolean; Virtual; abstract;
|
||||
// Session timeout in minutes
|
||||
Property TimeOutMinutes : Integer Read FTimeOut Write FTimeOut default 15;
|
||||
// ID of this session.
|
||||
@ -595,6 +597,7 @@ type
|
||||
|
||||
THandleCORSOption = (hcDetect, // Detect OPTIONS request, send full headers
|
||||
hcFull, // Force sending full headers
|
||||
hcHumanReadable, // Human readable result
|
||||
hcSend // In case of full headers, send response
|
||||
);
|
||||
THandleCORSOptions = set of THandleCORSOption;
|
||||
@ -1092,7 +1095,7 @@ Const
|
||||
6,7,8,
|
||||
9,-1,-1,-1,
|
||||
10,12,-1,13,-1,
|
||||
14,34,-1,15,-1,
|
||||
14,34,-1,15,26,
|
||||
-1,-1,16,17,-1,
|
||||
18,-1,-1,-1,19,
|
||||
20,21,-1,-1,
|
||||
|
||||
@ -46,6 +46,7 @@ Type
|
||||
Public
|
||||
Destructor Destroy; override;
|
||||
Procedure Terminate; override;
|
||||
function SessionVariableExists(VarName: String): Boolean; override;
|
||||
Procedure UpdateResponse(AResponse : TResponse); override;
|
||||
Procedure InitSession(ARequest : TRequest; OnNewSession, OnExpired: TNotifyEvent); override;
|
||||
Procedure InitResponse(AResponse : TResponse); override;
|
||||
@ -359,6 +360,12 @@ begin
|
||||
RemoveFromSessionState(ssExpired);
|
||||
end;
|
||||
|
||||
function TIniWebSession.SessionVariableExists(VarName: String): Boolean;
|
||||
begin
|
||||
CheckSession;
|
||||
Result:=FIniFile.ValueExists(SData,VarName);
|
||||
end;
|
||||
|
||||
procedure TIniWebSession.UpdateResponse(AResponse: TResponse);
|
||||
begin
|
||||
// Do nothing. Init has done the job.
|
||||
|
||||
@ -20,7 +20,7 @@ unit webjsonrpc;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpjson, fpjsonrpc, httpdefs, fphttp, jsonparser, uriparser;
|
||||
Classes, SysUtils, fpjson, fpjsonrpc, httpdefs, fphttp, jsonscanner, jsonparser;
|
||||
|
||||
Type
|
||||
{ ---------------------------------------------------------------------
|
||||
@ -82,9 +82,20 @@ Type
|
||||
end;
|
||||
|
||||
{ TCustomJSONRPCModule }
|
||||
TAPIRequestSource = (asURL, // Next part of URL: RPC/API
|
||||
asQuery // Next part of URL: RPC?API=1
|
||||
);
|
||||
Const
|
||||
DefaultAPIRequestSources = [asURL, asQuery];
|
||||
|
||||
type
|
||||
TAPIRequestSources = Set of TAPIRequestSource;
|
||||
|
||||
TCustomJSONRPCModule = Class(TJSONRPCDispatchModule)
|
||||
private
|
||||
FAPICreateOptions: TCreateAPIOptions;
|
||||
FAPIRequestName: String;
|
||||
FAPIRequestSources: TAPIRequestSources;
|
||||
FDispatcher: TCustomJSONRPCDispatcher;
|
||||
FOptions: TJSONRPCDispatchOptions;
|
||||
FRequest: TRequest;
|
||||
@ -92,11 +103,20 @@ Type
|
||||
FResponseContentType: String;
|
||||
procedure SetDispatcher(const AValue: TCustomJSONRPCDispatcher);
|
||||
Protected
|
||||
function GetAPI(aDisp: TCustomJSONRPCDispatcher; ARequest: TRequest): TJSONStringType; virtual;
|
||||
Function GetResponseContentType : String;
|
||||
Function CreateDispatcher : TCustomJSONRPCDispatcher; virtual;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation);override;
|
||||
Function IsAPIRequest(ARequest : TRequest) : Boolean; virtual;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
Property Dispatcher : TCustomJSONRPCDispatcher Read FDispatcher Write SetDispatcher;
|
||||
// Options to use when creating a custom dispatcher
|
||||
Property DispatchOptions : TJSONRPCDispatchOptions Read FOptions Write FOptions default DefaultDispatchOptions;
|
||||
// Where to look for API request
|
||||
property APIRequestSources : TAPIRequestSources Read FAPIRequestSources Write FAPIRequestSources default DefaultAPIRequestSources;
|
||||
// URL part or variable name to check for API request
|
||||
property APIRequestName : String Read FAPIRequestName Write FAPIRequestName;
|
||||
// API create options when creating a custom dispatcher
|
||||
Property APICreateOptions : TCreateAPIOptions Read FAPICreateOptions Write FAPICreateOptions;
|
||||
Public
|
||||
Constructor CreateNew(AOwner : TComponent; CreateMode : Integer); override;
|
||||
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
|
||||
@ -117,9 +137,12 @@ Type
|
||||
TJSONRPCModule = Class(TCustomJSONRPCModule)
|
||||
Published
|
||||
Property Dispatcher;
|
||||
// Only if Dispatcher is not set
|
||||
Property DispatchOptions;
|
||||
Property ResponseContentType;
|
||||
Property CORS;
|
||||
Property APIRequestSources;
|
||||
Property APIRequestName;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -150,7 +173,7 @@ Var
|
||||
|
||||
begin
|
||||
Disp:=Self.GetDispatcher;
|
||||
P:= TJSONParser.Create(ARequest.Content);
|
||||
P:= TJSONParser.Create(ARequest.Content,[joUTF8]);
|
||||
try
|
||||
Res:=Nil;
|
||||
Req:=Nil;
|
||||
@ -239,9 +262,20 @@ Var
|
||||
begin
|
||||
S:=TSessionJSONRPCDispatcher.Create(Self);
|
||||
S.Options:=DispatchOptions;
|
||||
S.APICreator.DefaultOptions:=APICreateOptions;
|
||||
S.APICreator.URL:=Self.BaseURL;
|
||||
Result:=S;
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCModule.IsAPIRequest(ARequest: TRequest): Boolean;
|
||||
begin
|
||||
Result:=False;
|
||||
if (asURL in APIRequestSources) then
|
||||
Result:=SameText(aRequest.GetNextPathInfo,APIRequestName);
|
||||
if (asQuery in APIRequestSources) then
|
||||
Result:=Result or (aRequest.QueryFields.Values[APIRequestName]<>'');
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomJSONRPCModule.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
@ -255,13 +289,36 @@ constructor TCustomJSONRPCModule.CreateNew(AOwner: TComponent;
|
||||
CreateMode: Integer);
|
||||
begin
|
||||
inherited CreateNew(AOwner, CreateMode);
|
||||
FOptions:=DefaultDispatchOptions+[jdoSearchRegistry];
|
||||
FOptions := DefaultDispatchOptions+[jdoSearchRegistry];
|
||||
APIRequestSources := DefaultAPIRequestSources;
|
||||
APICreateOptions:=[caoFullParams];
|
||||
end;
|
||||
|
||||
Function TCustomJSONRPCModule.GetAPI(aDisp : TCustomJSONRPCDispatcher; ARequest: TRequest) : TJSONStringType;
|
||||
|
||||
var
|
||||
B : Boolean;
|
||||
APIOptions : TCreateAPIOptions;
|
||||
|
||||
procedure TCustomJSONRPCModule.HandleRequest(ARequest: TRequest;
|
||||
AResponse: TResponse);
|
||||
begin
|
||||
B:=False;
|
||||
APIOptions:=[];
|
||||
if (aRequest.QueryFields.Values['extended']<>'') or (aRequest.QueryFields.Values['full']<>'') then
|
||||
begin
|
||||
Include(APIOptions,caoFullParams);
|
||||
B:=true;
|
||||
end;
|
||||
if (aRequest.QueryFields.Values['formatted']<>'') or (aRequest.QueryFields.Values['humanreadable']<>'') then
|
||||
begin
|
||||
Include(APIOptions,caoFormatted);
|
||||
B:=true;
|
||||
end;
|
||||
if Not B then
|
||||
APIOptions:=aDisp.APICreator.DefaultOptions;
|
||||
Result:=aDisp.APIAsString(APIOptions);
|
||||
end;
|
||||
|
||||
procedure TCustomJSONRPCModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
|
||||
|
||||
Var
|
||||
Disp : TCustomJSONRPCDispatcher;
|
||||
@ -269,31 +326,42 @@ Var
|
||||
R : TJSONStringType;
|
||||
|
||||
begin
|
||||
if SameText(ARequest.Method,'OPTIONS') then
|
||||
if not CORS.HandleRequest(aRequest,aResponse,[hcDetect,hcSend]) then
|
||||
if CORS.HandleRequest(aRequest,aResponse,[hcDetect,hcSend]) then
|
||||
exit;
|
||||
If (Dispatcher=Nil) then
|
||||
Dispatcher:=CreateDispatcher;
|
||||
Disp:=Dispatcher;
|
||||
R:='';
|
||||
if IsAPIRequest(aRequest) then
|
||||
begin
|
||||
if (jdoAllowAPI in TJSONRPCDispatcher(Disp).Options) then
|
||||
R:=GetAPI(Disp,aRequest)
|
||||
else
|
||||
begin
|
||||
Response.Code:=403;
|
||||
Response.CodeText:='FORBIDDEN';
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
If (Dispatcher=Nil) then
|
||||
Dispatcher:=CreateDispatcher;
|
||||
Disp:=Dispatcher;
|
||||
Res:=DispatchRequest(ARequest,Disp);
|
||||
try
|
||||
CORS.HandleRequest(aRequest,aResponse,[]);
|
||||
If Assigned(Res) then
|
||||
begin
|
||||
AResponse.FreeContentStream:=True;
|
||||
AResponse.ContentStream:=TMemoryStream.Create;
|
||||
if Assigned(Res) then
|
||||
R:=Res.AsJSON;
|
||||
if Length(R)>0 then
|
||||
AResponse.ContentStream.WriteBuffer(R[1],Length(R));
|
||||
AResponse.ContentLength:=AResponse.ContentStream.Size;
|
||||
R:=''; // Free up mem
|
||||
AResponse.ContentType:=GetResponseContentType;
|
||||
end;
|
||||
AResponse.SendResponse;
|
||||
finally
|
||||
Res.Free;
|
||||
end;
|
||||
end;
|
||||
AResponse.ContentType:=GetResponseContentType;
|
||||
if (R<>'') then
|
||||
begin
|
||||
AResponse.FreeContentStream:=True;
|
||||
AResponse.ContentStream:=TMemoryStream.Create;
|
||||
AResponse.ContentStream.WriteBuffer(R[1],Length(R));
|
||||
AResponse.ContentLength:=AResponse.ContentStream.Size;
|
||||
R:=''; // Free up mem
|
||||
end;
|
||||
AResponse.SendResponse;
|
||||
end;
|
||||
|
||||
{ TJSONRPCSessionContext }
|
||||
@ -322,7 +390,7 @@ var
|
||||
|
||||
|
||||
begin
|
||||
P:= TJSONParser.Create(ARequest.Content);
|
||||
P:= TJSONParser.Create(ARequest.Content,[joUTF8]);
|
||||
try
|
||||
Result:=Nil;
|
||||
Req:=Nil;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user