mORMot and Open Source friends
Check-in [c6e0a46f42]
Check-in [c6e0a46f42]
Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
| Comment: | {785} ensure TSQLHttpServer will answer to the incoming requests matching the registered security protocol, i.e. either HTTP or HTTPS |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
c6e0a46f42afa8d093aafc8955a65d4c |
| User & Date: | ab 2015-01-30 13:23:27 |
|
2015-01-30
| ||
| 13:25 | {786} some fixes to FastCGI protocol process - not yet working, and would definitively need a much deeper refactoring in the future, to be implemented as THttpFastCGIServer = class(THttpServerGeneric) check-in: dbdc68fb44 user: ab tags: trunk | |
| 13:23 | {785} ensure TSQLHttpServer will answer to the incoming requests matching the registered security protocol, i.e. either HTTP or HTTPS check-in: c6e0a46f42 user: ab tags: trunk | |
| 13:21 | {784} introducing TSQLRestURIParams.LowLevelRequest property as opaque reference to the protocol context which made the incoming request check-in: 0b4c8674b1 user: ab tags: trunk | |
Changes to SQLite3/mORMotHttpServer.pas.
259 260 261 262 263 264 265 266 267 268 269 270 271 272 ... 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 ... 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 ... 549 550 551 552 553 554 555 556 557 558 559 560 561 562 ... 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 ... 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 ... 739 740 741 742 743 744 745 746 747 748 749 750 751 752 |
fOnlyJSONRequests: boolean;
fHttpServer: THttpServerGeneric;
fPort, fDomainName: AnsiString;
/// internal servers to compute responses
fDBServers: array of record
Server: TSQLRestServer;
RestAccessRights: PSQLAccessRights;
end;
fHosts: TSynNameValue;
fAccessControlAllowOrigin: RawUTF8;
fAccessControlAllowOriginHeader: RawUTF8;
fRootRedirectToURI: array[boolean] of RawUTF8;
fHttpServerKind: TSQLHttpServerOptions;
fLog: TSynLogClass;
................................................................................
begin
result := False;
if (self=nil) or (aServer=nil) or (aServer.Model=nil) then
exit;
fLog.Enter(self);
try
for i := 0 to high(fDBServers) do
if fDBServers[i].Server.Model.Root=aServer.Model.Root then
exit; // register only once per URI Root address
{$ifndef ONLYUSEHTTPSOCKET}
if HttpApiAddUri(aServer.Model.Root,fDomainName,aHttpServerSecurity,
fHttpServerKind=useHttpApiRegisteringURI,false)<>'' then
exit;
{$endif}
n := length(fDBServers);
SetLength(fDBServers,n+1);
fDBServers[n].Server := aServer;
if aRestAccessRights=nil then
aRestAccessRights := HTTP_DEFAULT_ACCESS_RIGHTS;
fDBServers[n].RestAccessRights := aRestAccessRights;
result := true;
finally
fLog.Add.Log(sllDebug,'%.AddServer(%,Root=%,Port=%)=%',
[self,aServer,aServer.Model.Root,fPort,JSON_BOOLEAN[Result]]);
end;
end;
................................................................................
fLog.Enter(self);
try
n := high(fDBServers);
for i := 0 to n do
if fDBServers[i].Server=aServer then begin
{$ifndef ONLYUSEHTTPSOCKET}
if fHttpServer.InheritsFrom(THttpApiServer) then
if THttpApiServer(fHttpServer).
RemoveUrl(aServer.Model.Root,fPort,false,fDomainName)<>NO_ERROR then
fLog.Add.Log(sllLastError,'RemoveUrl(%)',[aServer.Model.Root]);
{$endif}
for j := i to n-1 do
fDBServers[j] := fDBServers[j+1];
SetLength(fDBServers,n);
result := true;
break;
end;
finally
fLog.Add.Log(sllDebug,'result=% for Root=%',[JSON_BOOLEAN[Result],aServer.Model.Root]);
end;
end;
procedure TSQLHttpServer.DomainHostRedirect(const aDomain,aURI: RawUTF8);
................................................................................
raise EModelException.CreateUTF8('%.Create(% ): %',[self,ServersRoot,ErrMsg]);
SetAccessControlAllowOrigin(''); // deny CORS by default
SetLength(fDBServers,length(aServers));
for i := 0 to high(aServers) do
with fDBServers[i] do begin
Server := aServers[i];
RestAccessRights := HTTP_DEFAULT_ACCESS_RIGHTS;
end;
{$ifndef USETCPPREFIX}
{$ifndef ONLYUSEHTTPSOCKET}
if aHttpServerKind in [useHttpApi,useHttpApiRegisteringURI] then
try
// first try to use fastest http.sys
fHttpServer := THttpApiServer.Create(false,aQueueName);
................................................................................
HttpApiAddUri(aServers[i].Model.Root,fDomainName,aHttpServerSecurity,
fHttpServerKind=useHttpApiRegisteringURI,true);
if aAdditionalURL<>'' then
HttpApiAddUri(aAdditionalURL,fDomainName,aHttpServerSecurity,
fHttpServerKind=useHttpApiRegisteringURI,true);
except
on E: Exception do begin
fLog.Add.Log(sllError,'% for % at%',[E,fHttpServer,ServersRoot],self);
FreeAndNil(fHttpServer); // if http.sys initialization failed
end;
end;
{$endif}
{$endif}
if fHttpServer=nil then begin
// http.sys failed -> create one instance of our pure Delphi server
................................................................................
aHttpServerSecurity,aAdditionalURL,aQueueName);
if aRestAccessRights<>nil then
DBServerAccessRight[0] := aRestAccessRights;
end;
destructor TSQLHttpServer.Destroy;
begin
fLog.Enter(self).Log(sllInfo,'% finalized for % server(s)',[fHttpServer,length(fDBServers)],self);
FreeAndNil(fHttpServer);
inherited Destroy;
end;
procedure TSQLHttpServer.Shutdown;
var i: integer;
begin
................................................................................
if Ctxt.URL[1]='/' then
call.Url := copy(Ctxt.URL,2,maxInt) else
call.Url := Ctxt.URL;
// search and call any matching TSQLRestServer instance
result := HTML_NOTFOUND; // page not found by default (in case of wrong URL)
for i := 0 to high(fDBServers) do
with fDBServers[i] do
if Server.Model.URIMatch(call.Url) then begin
call.Method := Ctxt.Method;
call.InHead := Ctxt.InHeaders;
call.InBody := Ctxt.InContent;
call.RestAccessRights := RestAccessRights;
Server.URI(call);
// set output content
|
> | > > | > | | | > | | | | < > > | | > > |
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 ... 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 ... 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 ... 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 ... 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 ... 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 ... 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 |
fOnlyJSONRequests: boolean;
fHttpServer: THttpServerGeneric;
fPort, fDomainName: AnsiString;
/// internal servers to compute responses
fDBServers: array of record
Server: TSQLRestServer;
RestAccessRights: PSQLAccessRights;
Security: TSQLHttpServerSecurity;
end;
fHosts: TSynNameValue;
fAccessControlAllowOrigin: RawUTF8;
fAccessControlAllowOriginHeader: RawUTF8;
fRootRedirectToURI: array[boolean] of RawUTF8;
fHttpServerKind: TSQLHttpServerOptions;
fLog: TSynLogClass;
................................................................................
begin
result := False;
if (self=nil) or (aServer=nil) or (aServer.Model=nil) then
exit;
fLog.Enter(self);
try
for i := 0 to high(fDBServers) do
if (fDBServers[i].Server.Model.Root=aServer.Model.Root) and
(fDBServers[i].Security=aHttpServerSecurity) then
exit; // register only once per URI Root address
{$ifndef ONLYUSEHTTPSOCKET}
if HttpApiAddUri(aServer.Model.Root,fDomainName,aHttpServerSecurity,
fHttpServerKind=useHttpApiRegisteringURI,false)<>'' then
exit;
{$endif}
n := length(fDBServers);
SetLength(fDBServers,n+1);
with fDBServers[n] do begin
Server := aServer;
Security := aHttpServerSecurity;
if aRestAccessRights=nil then
RestAccessRights := HTTP_DEFAULT_ACCESS_RIGHTS else
RestAccessRights := aRestAccessRights;
end;
result := true;
finally
fLog.Add.Log(sllDebug,'%.AddServer(%,Root=%,Port=%)=%',
[self,aServer,aServer.Model.Root,fPort,JSON_BOOLEAN[Result]]);
end;
end;
................................................................................
fLog.Enter(self);
try
n := high(fDBServers);
for i := 0 to n do
if fDBServers[i].Server=aServer then begin
{$ifndef ONLYUSEHTTPSOCKET}
if fHttpServer.InheritsFrom(THttpApiServer) then
if THttpApiServer(fHttpServer).RemoveUrl(aServer.Model.Root,fPort,
fDBServers[i].Security=secSSL,fDomainName)<>NO_ERROR then
fLog.Add.Log(sllLastError,'RemoveUrl(%)',[aServer.Model.Root]);
{$endif}
for j := i to n-1 do
fDBServers[j] := fDBServers[j+1];
SetLength(fDBServers,n);
result := true; // don't break here: may appear with another Security
end;
finally
fLog.Add.Log(sllDebug,'result=% for Root=%',[JSON_BOOLEAN[Result],aServer.Model.Root]);
end;
end;
procedure TSQLHttpServer.DomainHostRedirect(const aDomain,aURI: RawUTF8);
................................................................................
raise EModelException.CreateUTF8('%.Create(% ): %',[self,ServersRoot,ErrMsg]);
SetAccessControlAllowOrigin(''); // deny CORS by default
SetLength(fDBServers,length(aServers));
for i := 0 to high(aServers) do
with fDBServers[i] do begin
Server := aServers[i];
RestAccessRights := HTTP_DEFAULT_ACCESS_RIGHTS;
Security := aHttpServerSecurity;
end;
{$ifndef USETCPPREFIX}
{$ifndef ONLYUSEHTTPSOCKET}
if aHttpServerKind in [useHttpApi,useHttpApiRegisteringURI] then
try
// first try to use fastest http.sys
fHttpServer := THttpApiServer.Create(false,aQueueName);
................................................................................
HttpApiAddUri(aServers[i].Model.Root,fDomainName,aHttpServerSecurity,
fHttpServerKind=useHttpApiRegisteringURI,true);
if aAdditionalURL<>'' then
HttpApiAddUri(aAdditionalURL,fDomainName,aHttpServerSecurity,
fHttpServerKind=useHttpApiRegisteringURI,true);
except
on E: Exception do begin
fLog.Add.Log(sllError,'% for % at% -> fallback to socket-based server',
[E,fHttpServer,ServersRoot],self);
FreeAndNil(fHttpServer); // if http.sys initialization failed
end;
end;
{$endif}
{$endif}
if fHttpServer=nil then begin
// http.sys failed -> create one instance of our pure Delphi server
................................................................................
aHttpServerSecurity,aAdditionalURL,aQueueName);
if aRestAccessRights<>nil then
DBServerAccessRight[0] := aRestAccessRights;
end;
destructor TSQLHttpServer.Destroy;
begin
fLog.Enter(self).Log(sllInfo,'% finalized for % server(s)',
[fHttpServer,length(fDBServers)],self);
FreeAndNil(fHttpServer);
inherited Destroy;
end;
procedure TSQLHttpServer.Shutdown;
var i: integer;
begin
................................................................................
if Ctxt.URL[1]='/' then
call.Url := copy(Ctxt.URL,2,maxInt) else
call.Url := Ctxt.URL;
// search and call any matching TSQLRestServer instance
result := HTML_NOTFOUND; // page not found by default (in case of wrong URL)
for i := 0 to high(fDBServers) do
with fDBServers[i] do
if Ctxt.UseSSL=(Security=secSSL) then // registered for http or https
if Server.Model.URIMatch(call.Url) then begin
call.Method := Ctxt.Method;
call.InHead := Ctxt.InHeaders;
call.InBody := Ctxt.InContent;
call.RestAccessRights := RestAccessRights;
Server.URI(call);
// set output content
|
Changes to SynopseCommit.inc.
1 |
'1.18.784'
|
| |
1 |
'1.18.785'
|