Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | {5957} refactored THttpServer internal execution flag |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
6934f7976645e0ed4dbd80df56d0c38a |
User & Date: | ab 2020-04-16 18:40:10 |
2020-04-19
| ||
11:36 | {5958} introducing TSynLogFamily.ExceptionIgnorePerThread property check-in: 07e21d977f user: ab tags: trunk | |
2020-04-16
| ||
18:40 | {5957} refactored THttpServer internal execution flag check-in: 6934f79766 user: ab tags: trunk | |
17:32 | {5956} Socket.Bind should throw in case of fatal error during bind - from https://github.com/synopse/mORMot/pull/309 check-in: d511e65f58 user: ab tags: trunk | |
Changes to SynCrtSock.pas.
1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 .... 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 .... 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 .... 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 .... 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 |
fServerKeepAliveTimeOut: cardinal; fTCPPrefix: SockString; fSock: TCrtSocket; fThreadRespClass: THttpServerRespClass; fOnSendFile: TOnHttpServerSendFile; fNginxSendFileFrom: array of TFileName; fHTTPQueueLength: cardinal; fExecuteFinished: boolean; fStats: array[THttpServerSocketGetRequestResult] of integer; fSocketClass: THttpServerSocketClass; fHeadersNotFiltered: boolean; function GetStat(one: THttpServerSocketGetRequestResult): integer; function GetHTTPQueueLength: Cardinal; override; procedure SetHTTPQueueLength(aValue: Cardinal); override; procedure InternalHttpServerRespListAdd(resp: THttpServerResp); ................................................................................ constructor THttpServer.Create(const aPort: SockString; OnStart, OnStop: TNotifyThreadEvent; const ProcessName: SockString; ServerThreadPoolCount: integer; KeepAliveTimeOut: integer; HeadersUnFiltered: boolean); begin fInternalHttpServerRespList := {$ifdef FPC}TFPList{$else}TList{$endif}.Create; InitializeCriticalSection(fProcessCS); fExecuteFinished := true; // prevent hangs in case of Bind error fSock := TCrtSocket.Bind(aPort); // BIND + LISTEN fServerKeepAliveTimeOut := KeepAliveTimeOut; // 30 seconds by default if fThreadPool<>nil then fThreadPool.ContentionAbortDelay := 5000; // 5 seconds default // event handlers set before inherited Create to be visible in childs fOnHttpThreadStart := OnStart; SetOnTerminate(OnStop); ................................................................................ var endtix: Int64; i: integer; resp: THttpServerResp; begin Terminate; // set Terminated := true for THttpServerResp.Execute if fThreadPool<>nil then fThreadPool.fTerminated := true; // notify background process if not fExecuteFinished and (Sock<>nil) then begin Sock.Close; // shutdown the socket to unlock Accept() in Execute DirectShutdown(CallServer('127.0.0.1',Sock.Port,false,cslTCP,1)); end; endtix := GetTick64+20000; EnterCriticalSection(fProcessCS); try if fInternalHttpServerRespList<>nil then begin for i := 0 to fInternalHttpServerRespList.Count-1 do begin resp := fInternalHttpServerRespList.List[i]; resp.Terminate; DirectShutdown(resp.fServerSock.Sock,{rdwr=}true); end; repeat // wait for all THttpServerResp.Execute to be finished if (fInternalHttpServerRespList.Count=0) and fExecuteFinished then break; LeaveCriticalSection(fProcessCS); SleepHiRes(100); EnterCriticalSection(fProcessCS); until GetTick64>endtix; FreeAndNil(fInternalHttpServerRespList); end; ................................................................................ ClientSin: TVarSin; ClientCrtSock: THttpServerSocket; {$ifdef MONOTHREAD} endtix: Int64; {$endif} begin // THttpServerGeneric thread preparation: launch any OnHttpThreadStart event fExecuteFinished := false; NotifyThreadStart(self); // main server process loop if Sock.Sock>0 then try while not Terminated do begin ClientSock := Accept(Sock.Sock,ClientSin); if ClientSock<=0 then ................................................................................ {$endif MONOTHREAD} end; except on Exception do ; // any exception would break and release the thread end; EnterCriticalSection(fProcessCS); fExecuteFinished := true; LeaveCriticalSection(fProcessCS); end; procedure THttpServer.OnConnect; begin InterLockedIncrement(fServerConnectionCount); InterLockedIncrement(fServerConnectionActive); |
| < | | | | |
1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 .... 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 .... 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 .... 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 .... 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 |
fServerKeepAliveTimeOut: cardinal; fTCPPrefix: SockString; fSock: TCrtSocket; fThreadRespClass: THttpServerRespClass; fOnSendFile: TOnHttpServerSendFile; fNginxSendFileFrom: array of TFileName; fHTTPQueueLength: cardinal; fExecuteState: (esNotStarted, esRunning, esFinished); fStats: array[THttpServerSocketGetRequestResult] of integer; fSocketClass: THttpServerSocketClass; fHeadersNotFiltered: boolean; function GetStat(one: THttpServerSocketGetRequestResult): integer; function GetHTTPQueueLength: Cardinal; override; procedure SetHTTPQueueLength(aValue: Cardinal); override; procedure InternalHttpServerRespListAdd(resp: THttpServerResp); ................................................................................ constructor THttpServer.Create(const aPort: SockString; OnStart, OnStop: TNotifyThreadEvent; const ProcessName: SockString; ServerThreadPoolCount: integer; KeepAliveTimeOut: integer; HeadersUnFiltered: boolean); begin fInternalHttpServerRespList := {$ifdef FPC}TFPList{$else}TList{$endif}.Create; InitializeCriticalSection(fProcessCS); fSock := TCrtSocket.Bind(aPort); // BIND + LISTEN fServerKeepAliveTimeOut := KeepAliveTimeOut; // 30 seconds by default if fThreadPool<>nil then fThreadPool.ContentionAbortDelay := 5000; // 5 seconds default // event handlers set before inherited Create to be visible in childs fOnHttpThreadStart := OnStart; SetOnTerminate(OnStop); ................................................................................ var endtix: Int64; i: integer; resp: THttpServerResp; begin Terminate; // set Terminated := true for THttpServerResp.Execute if fThreadPool<>nil then fThreadPool.fTerminated := true; // notify background process if (fExecuteState=esRunning) and (Sock<>nil) then begin Sock.Close; // shutdown the socket to unlock Accept() in Execute DirectShutdown(CallServer('127.0.0.1',Sock.Port,false,cslTCP,1)); end; endtix := GetTick64+20000; EnterCriticalSection(fProcessCS); try if fInternalHttpServerRespList<>nil then begin for i := 0 to fInternalHttpServerRespList.Count-1 do begin resp := fInternalHttpServerRespList.List[i]; resp.Terminate; DirectShutdown(resp.fServerSock.Sock,{rdwr=}true); end; repeat // wait for all THttpServerResp.Execute to be finished if (fInternalHttpServerRespList.Count=0) and (fExecuteState<>esRunning) then break; LeaveCriticalSection(fProcessCS); SleepHiRes(100); EnterCriticalSection(fProcessCS); until GetTick64>endtix; FreeAndNil(fInternalHttpServerRespList); end; ................................................................................ ClientSin: TVarSin; ClientCrtSock: THttpServerSocket; {$ifdef MONOTHREAD} endtix: Int64; {$endif} begin // THttpServerGeneric thread preparation: launch any OnHttpThreadStart event fExecuteState := esRunning; NotifyThreadStart(self); // main server process loop if Sock.Sock>0 then try while not Terminated do begin ClientSock := Accept(Sock.Sock,ClientSin); if ClientSock<=0 then ................................................................................ {$endif MONOTHREAD} end; except on Exception do ; // any exception would break and release the thread end; EnterCriticalSection(fProcessCS); fExecuteState := esFinished; LeaveCriticalSection(fProcessCS); end; procedure THttpServer.OnConnect; begin InterLockedIncrement(fServerConnectionCount); InterLockedIncrement(fServerConnectionActive); |
Changes to SynopseCommit.inc.
1 |
'1.18.5956'
|
| |
1 |
'1.18.5957'
|