mORMot and Open Source friends
Check-in [653f828d99]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:{1738} another FPC 64 bit compilation fix for HTTP server
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 653f828d99177515c34e7c9b6edb91c743077d90
User & Date: ab 2015-08-05 12:36:22
Context
2015-08-05
16:42
{1739} small fixes about FPC 64 bit and DDD check-in: bce9a9ab19 user: ab tags: trunk
12:36
{1738} another FPC 64 bit compilation fix for HTTP server check-in: 653f828d99 user: ab tags: trunk
06:35
{1737} fixed FPC 64 bit compilation for HTTP server - target not fully supported by now - thanks marius maximus for the path check-in: 1b58480d8e user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SynCrtSock.pas.

2822
2823
2824
2825
2826
2827
2828



2829

2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
....
3836
3837
3838
3839
3840
3841
3842

3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897

3898
3899
3900
3901
3902
3903
3904
    vtPChar:      SockSend(VPChar,StrLen(VPChar));
    vtChar:       SockSend(@VChar,1);
    vtWideChar:   SockSend(@VWideChar,1); // only ansi part of the character
    vtInteger:    begin
      Str(VInteger,tmp);
      SockSend(@tmp[1],length(tmp));
    end;



  end;

  SockSend(@CRLF, 2);
end;

procedure TCrtSocket.SockSend(const Line: SockString);
begin
  if Line<>'' then
    SockSend(pointer(Line),length(Line));
  SockSend(@CRLF, 2);
end;

procedure TCrtSocket.SockSendFlush;
begin
  if fSndBufLen=0 then
    exit;
  SndLow(pointer(fSndBuf),fSndBufLen);
................................................................................
  end;
  fConnectionID := fServer.NextConnectionID;
  inherited Create(false);
  FreeOnTerminate := true;
end;

procedure THttpServerResp.Execute;

procedure HandleRequestsProcess;
var StartTick, StopTick, Tick: cardinal;
    pending: TCrtSocketPending;
begin
  {$ifdef USETHREADPOOL}
  if fThreadPool<>nil then
    InterlockedIncrement(fThreadPool.FGeneratedThreadCount);
  {$endif}
  try
  try
    repeat
      StartTick := GetTickCount;
      StopTick := StartTick+fServer.ServerKeepAliveTimeOut;
      repeat // within this loop, break=wait for next command, exit=quit
        if (fServer=nil) or fServer.Terminated or (fServerSock=nil) then
          exit; // server is down -> close connection
        pending := fServerSock.SockReceivePending(50); // 50 ms timeout
        if (fServer=nil) or fServer.Terminated then
          exit; // server is down -> disconnect the client
        case pending of
        cspSocketError:
          exit; // socket error -> disconnect the client
        cspNoData: begin
          Tick := GetTickCount;  // wait for keep alive timeout
          if Tick<StartTick then // time wrap after continuous run for 49.7 days
            break; // reset Ticks count + retry
          if Tick>=StopTick then
            exit; // reached time out -> close connection
        end;
        cspDataAvailable: begin
          // get request and headers
          if not fServerSock.GetRequest(True) then
            // fServerSock connection was down or headers are not correct
            exit;
          // calc answer and send response
          fServer.Process(fServerSock,ConnectionID,self);
          // keep connection only if necessary
          if fServerSock.KeepAliveClient then
            break else
            exit;
        end;
        end;
       until false;
    until false;
  finally
    {$ifdef USETHREADPOOL}
    if fThreadPool<>nil then
      InterlockedDecrement(fThreadPool.FGeneratedThreadCount);
    {$endif}
  end;
  except
    on E: Exception do
      ; // any exception will silently disconnect the client
  end;
end;

var aSock: TSocket;
    i: integer;
begin
  try
    try
      if fClientSock<>0 then begin
        // direct call from incoming socket






>
>
>
|
>
|






|







 







>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>







2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
....
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
    vtPChar:      SockSend(VPChar,StrLen(VPChar));
    vtChar:       SockSend(@VChar,1);
    vtWideChar:   SockSend(@VWideChar,1); // only ansi part of the character
    vtInteger:    begin
      Str(VInteger,tmp);
      SockSend(@tmp[1],length(tmp));
    end;
    vtInt64:    begin
      Str(VInteger,tmp);
      SockSend(@tmp[1],length(tmp));
    end;
  end;
  SockSend(@CRLF,2);
end;

procedure TCrtSocket.SockSend(const Line: SockString);
begin
  if Line<>'' then
    SockSend(pointer(Line),length(Line));
  SockSend(@CRLF,2);
end;

procedure TCrtSocket.SockSendFlush;
begin
  if fSndBufLen=0 then
    exit;
  SndLow(pointer(fSndBuf),fSndBufLen);
................................................................................
  end;
  fConnectionID := fServer.NextConnectionID;
  inherited Create(false);
  FreeOnTerminate := true;
end;

procedure THttpServerResp.Execute;

  procedure HandleRequestsProcess;
  var StartTick, StopTick, Tick: cardinal;
      pending: TCrtSocketPending;
  begin
    {$ifdef USETHREADPOOL}
    if fThreadPool<>nil then
      InterlockedIncrement(fThreadPool.FGeneratedThreadCount);
    {$endif}
    try
    try
      repeat
        StartTick := GetTickCount;
        StopTick := StartTick+fServer.ServerKeepAliveTimeOut;
        repeat // within this loop, break=wait for next command, exit=quit
          if (fServer=nil) or fServer.Terminated or (fServerSock=nil) then
            exit; // server is down -> close connection
          pending := fServerSock.SockReceivePending(50); // 50 ms timeout
          if (fServer=nil) or fServer.Terminated then
            exit; // server is down -> disconnect the client
          case pending of
          cspSocketError:
            exit; // socket error -> disconnect the client
          cspNoData: begin
            Tick := GetTickCount;  // wait for keep alive timeout
            if Tick<StartTick then // time wrap after continuous run for 49.7 days
              break; // reset Ticks count + retry
            if Tick>=StopTick then
              exit; // reached time out -> close connection
          end;
          cspDataAvailable: begin
            // get request and headers
            if not fServerSock.GetRequest(True) then
              // fServerSock connection was down or headers are not correct
              exit;
            // calc answer and send response
            fServer.Process(fServerSock,ConnectionID,self);
            // keep connection only if necessary
            if fServerSock.KeepAliveClient then
              break else
              exit;
          end;
          end;
         until false;
      until false;
    finally
      {$ifdef USETHREADPOOL}
      if fThreadPool<>nil then
        InterlockedDecrement(fThreadPool.FGeneratedThreadCount);
      {$endif}
    end;
    except
      on E: Exception do
        ; // any exception will silently disconnect the client
    end;
  end;

var aSock: TSocket;
    i: integer;
begin
  try
    try
      if fClientSock<>0 then begin
        // direct call from incoming socket

Changes to SynopseCommit.inc.

1
'1.18.1737'
|
1
'1.18.1738'