* Add support for Server-Sent Events

packages/fcl-web/examples/sse/README.md

@@ -0,0 +1,50 @@
+# Server-Sent events demo
+
+The testsse demo shows how to use HTTP server-sent events. The testsse.lpr
+project can function as a client (receiver) or as a source (server) of
+events.
+
+## Server demo
+To start the demo as a server, run
+```shell
+testsse -s
+```
+optionally, you can set a port with option `-p`:
+```shell
+testsse -s -p 3000
+```
+
+You can test the raw output with wget (or curl) like so:
+
+```shell
+wget --header="Accept: text/event-stream" "http://localhost:8080/events" -q -O -
+```
+The server understands the 'Last-Event-Id' header as specified in the spec,
+and will adapt the starting event accordingly:
+```shell
+wget --header="Accept: text/event-stream" --header="Last-Event-Id: 5" "http://localhost:8080/events" -q -O -
+```
+
+## Client demo
+To test the client, start the server (as described above) in one terminal
+window, and in another terminal window, start the client:
+To start the demo as a server, run
+```shell
+testsse -c
+```
+optionally, you can set the server port with option `-p`:
+```shell
+testsse -c -p 3000
+```
+optionally, you can set the last received ID with option `-l`:
+```shell
+testsse -c -l 5
+```
+The server will then start with event 6.
+
+You can also try to capture the event stream of another server than the
+testsse server. Specify the `u` or `url` option:
+```shell
+testsse -c -u http://example.com/some-events-resource/
+```
+

packages/fcl-web/examples/sse/testsse.lpi

@@ -0,0 +1,66 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testsse"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="testsse.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="fphttpserverevents.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testsse"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../src/base"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/sse/testsse.lpr

@@ -0,0 +1,171 @@
+program testsse;
+{$ifdef mswindows}
+{$apptype console}
+{$endif}
+uses sysutils, custApp, httpdefs, fphttpclient, httproute, fphttpserver;
+
+Type
+
+  { TEventSourceApp }
+
+  TEventSourceApp = class(TCustomApplication)
+  private
+    FPort : Integer;
+    FSource: TCustomHTTPEventSource;
+    procedure DoHTTPRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);
+    procedure DoServerEvents(ARequest: TRequest; AResponse: TResponse);
+    procedure ReadEvents(aSender: TObject; aSource: TCustomHTTPEventSource);
+    procedure RunEventLoop;
+  Protected
+    Procedure StartServer;
+    procedure StartClient;
+    Procedure Usage(const aMsg : string);
+    procedure DoRun; override;
+  end;
+
+procedure TEventSourceApp.DoServerEvents(ARequest: TRequest; AResponse: TResponse);
+var
+  lEvent : THTTPServerEvent;
+  i,lStartID : Integer;
+  lAccept : String;
+begin
+  lAccept:=aRequest.Accept;
+  if Pos('text/event-stream',lAccept)<>0 then
+    begin
+    aResponse.StartServerEvents;
+    LStartID:=StrToIntDef(aRequest.CustomHeaders.Values['Last-Event-ID'],0);
+    for I:=lStartID+1 to lStartID+10 do
+      begin
+      lEvent:=Default(THTTPServerEvent);
+      lEvent.Data:=['Ping event '+IntToStr(I)];
+      lEvent.Event:='ping';
+      lEvent.ID:=IntToStr(i);
+      aResponse.SendServerEvent(lEvent);
+      sleep(500);
+      end;
+    end;
+
+end;
+
+procedure TEventSourceApp.DoHTTPRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
+  var AResponse: TFPHTTPConnectionResponse);
+begin
+  HTTPRouter.RouteRequest(aRequest,aResponse);
+end;
+
+procedure TEventSourceApp.ReadEvents(aSender: TObject; aSource: TCustomHTTPEventSource);
+begin
+  FSource:=aSource;
+end;
+
+Procedure TEventSourceApp.RunEventLoop;
+var
+  lEvent : THTTPServerEvent;
+begin
+  while not FSource.EOF do
+    begin
+    if FSource.ReadEvent(lEvent) then
+       begin
+       Write('Got event');
+       if lEvent.Event<>'' then
+         Write(' of type: ',lEvent.Event);
+       if lEvent.Event<>'' then
+         Write(' with id: ',lEvent.Id);
+       Writeln('');
+       Writeln(lEvent.Data[0]);
+       Writeln('');
+       end;
+    end;
+  FSource.Free;
+  Terminate;
+end;
+
+procedure TEventSourceApp.StartServer;
+
+var
+  lServer : TFPHttpServer;
+begin
+  Writeln('Starting server, listening for requests on port ',FPort);
+  Writeln('Send requests to http://localhost:',FPort,'/events');
+  HTTPRouter.RegisterRoute('/events',rmAll,@DoServerEvents);
+  lServer:=TFPHttpServer.Create(Self);
+  try
+    lServer.OnRequest:=@DoHTTPRequest;
+    lServer.Port:=FPort;
+    lServer.Active:=True;
+  finally
+    lServer.Free;
+  end;
+end;
+
+Procedure TEventSourceApp.StartClient;
+
+var
+  lHTTP : TFPHTTPClient;
+  lLast : Integer;
+  lUrl,lResult : string;
+begin
+  lHTTP:=TFPHTTPClient.Create(Self);
+  lUrl:=GetOptionValue('u','url');
+  if lUrl='' then
+    lUrl:=Format('http://localhost:%d/events',[FPort]);
+  // lHTTP.OnEventStream:=@ReadEvents;
+  lHTTP.AddHeader('Accept','text/event-stream');
+  lLast:=StrToIntDef(GetOptionValue('l','last-id'),0);
+  if lLast<>0 then
+    lHTTP.AddHeader('Last-Event-Id',IntToStr(lLast));
+  FSource:=lHTTP.GetEventSource('GET',lURL);
+  // lResult:=lHTTP.Get(lUrl);
+  if FSource=nil then
+    Writeln('Get returned (Result=',lResult,')')
+  else
+    begin
+    Writeln('Have event source. Listening for events...');
+    RunEventLoop;
+    end;
+end;
+
+Procedure TEventSourceApp.Usage(const aMsg : String);
+begin
+  if aMsg<>'' then
+    Writeln('Error: ',aMsg);
+  Writeln('Usage : ',ExtractFileName(ParamStr(0)),' [options]');
+  Writeln('Where options is one of :');
+  Writeln('-h --help       This help');
+  Writeln('-c --client     Run in client mode');
+  Writeln('-p --port=PORT  Set server HTTP port number (both client and server)');
+  Writeln('-l --last-id=ID Set last event ID (client)');
+  Writeln('-s --server     Run in server mode');
+  Writeln('-u --url:URL    Connect to this URL.');
+  Writeln('                If not set, the default URL for testsse -r is used, taking -p in account');
+  ExitCode:=Ord(aMsg<>'');
+end;
+
+Procedure TEventSourceApp.DoRun;
+
+var
+  Err : string;
+begin
+  Terminate;
+  Err:=CheckOptions('chsp:l:u:',['client','help','server','port:','last-id:','url:']);
+  if (Err<>'') or HasOption('h','help') then
+    begin
+    Usage(Err);
+    exit;
+    end;
+  FPort:=StrToIntDef(GetOptionValue('p','port'),8080);
+  if HasOption('s','server') then
+    StartServer
+  else if HasOption('c','client') then
+    StartClient
+  else
+    Usage('Need run mode');
+end;
+
+begin
+  CustomApplication:=TEventSourceApp.Create(Nil);
+  CustomApplication.Initialize;
+  CustomApplication.Run;
+  CustomApplication.Free;
+end.
+

packages/fcl-web/src/base/fphttpclient.pp

@@ -48,6 +48,44 @@ Type
 
   TFPCustomHTTPClient = Class;
 
+
+
+  { TCustomHTTPEventSource }
+
+  TCustomHTTPEventSource = Class(TObject)
+  private
+    FSocket : TSocketStream;
+    FBuffer : AnsiString;
+    FTerminated : Boolean;
+    FHeaders : TStrings;
+    FEOF: Boolean;
+  protected
+    procedure Terminate; virtual;
+    function ReadFromSocket(var aBuffer; aCount: Longint): Longint; virtual;
+    function ReadString(out S: String): Boolean;
+    property Socket : TSocketStream read FSocket;
+    property Buffer : AnsiString read FBuffer;
+    property Terminated : boolean read FTerminated;
+  Public
+    constructor Create(aSocket : TSocketStream; const aBuffer : AnsiString);
+    Destructor Destroy; override;
+    // Is data available for reading ?
+    function DataAvailable : Boolean;
+    // Read one event. Will block. Returns false if no event was read.
+    function ReadEvent(out aEvent: THTTPServerEvent; aConcatData : Boolean = True): Boolean;
+    // Close the socket.
+    Procedure Close;
+    // Headers as returned by the server when initial HTTP request was made.
+    Property Headers : TStrings Read FHeaders;
+    // End of events was reached: server closed the stream.
+    Property EOF : Boolean Read FEOF;
+  end;
+
+  THTTPEventStreamHandler = Procedure(aSender : TObject; aSource : TCustomHTTPEventSource) of object;
+  // Default class returned by TFPCustomHTTPClient
+  THTTPEventSource = class(TCustomHTTPEventSource);
+
+
   { TProxyData }
 
   TProxyData = Class (TPersistent)
@@ -74,6 +112,7 @@ Type
   private
     FDataRead : Int64;
     FContentLength : Int64;
+    FOnEventStream: THTTPEventStreamHandler;
     FRequestCookies: TCookies;
     FRequestDataWritten : Int64;
     FRequestContentLength : Int64;
@@ -111,10 +150,12 @@ Type
     FAfterSocketHandlerCreated : TSocketHandlerCreatedEvent;
     FProxy : TProxyData;
     FVerifySSLCertificate: Boolean;
+    FGetEventSource :  TCustomHTTPEventSource;
     FCertCAFileName: String;
     FTrustedCertsDir: String;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
+    function CheckContentType : string;
     function CreateCookies: TCookies;
     function GetCookies: TStrings;
     function GetCookieList: TCookies;
@@ -131,7 +172,16 @@ Type
     procedure SetIOTimeout(AValue: Integer);
     Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
     Procedure CheckConnectionCloseHeader;
+    procedure GetEventSourceHandler(Sender : TObject; aSource : TCustomHTTPEventSource);
   protected
+    // Return header value. aHeader is the header name, followed by a colon ':'
+    function CheckHeader(const aHeader: string): string;
+    // Event stream handling:
+    function CreateEventSource(aSocket: TSocketStream; const aBuffer: AnsiString): TCustomHTTPEventSource; virtual;
+    // transfers socket to event stream handler.
+    procedure StartEventStream; virtual;
+    // Checks if the user has registered an event stream handler.
+    function HandlesEventstream : Boolean; virtual;
     // Called with TSSLSocketHandler as sender
     procedure DoVerifyCertificate(Sender: TObject; var Allow: Boolean); virtual;
     Function NoContentAllowed(ACode : Integer) : Boolean;
@@ -196,6 +246,10 @@ Type
     Procedure SendRequest(const AMethod: String; URI: TURI); virtual;
     // Create socket handler for protocol AProtocol. Calls OnGetSocketHandler.
     Function GetSocketHandler(Const UseSSL : Boolean) : TSocketHandler;  virtual;
+    // extract the socket and nil the socket.
+    Function ExtractSocket : TSocketStream;
+    // Return the buffer and empty the local buffer.
+    function ExtractBuffer : AnsiString;
   Public
     Constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;
@@ -224,6 +278,7 @@ Type
     Procedure Get(Const AURL : String; const LocalFileName : String);
     Procedure Get(Const AURL : String; Response : TStrings);
     Function Get(Const AURL : String) : RawByteString;
+    Function GetEventSource(const aMethod,aURL : String; const aBody : string = '') : TCustomHTTPEventSource;
     // Check if responsecode is a redirect code that this class handles (301,302,303,307,308)
     Class Function IsRedirect(ACode : Integer) : Boolean; virtual;
     // If the code is a redirect, then this method  must return TRUE if the next request should happen with a GET (307/308)
@@ -398,9 +453,13 @@ Type
     Property AfterSocketHandlerCreate : TSocketHandlerCreatedEvent Read FAfterSocketHandlerCreated Write FAfterSocketHandlerCreated;
     // Called when a SSL certificate must be verified.
     Property OnVerifySSLCertificate : THTTPVerifyCertificateEvent Read FOnVerifyCertificate Write FOnVerifyCertificate;
+    // Called when a server-sent event stream is detected
+    Property OnEventStream : THTTPEventStreamHandler Read FOnEventStream Write FOnEventStream;
   end;
 
 
+  { TFPHTTPClient }
+
   TFPHTTPClient = Class(TFPCustomHTTPClient)
   public
     Property ResponseCookies;
@@ -434,7 +493,7 @@ Type
     Property TrustedCertsDir;
     Property AfterSocketHandlerCreate;
     Property OnVerifySSLCertificate;
-
+    Property OnEventStream;
   end;
 
   EHTTPClient = Class(EHTTP)
@@ -472,6 +531,7 @@ resourcestring
   SErrChunkTooBig = 'Chunk too big: Got %d, maximum allowed size: %d';
   SErrChunkLineEndMissing = 'Chunk line end missing';
   SErrMaxRedirectsReached = 'Maximum allowed redirects reached : %d';
+  SErrNoEventStream = 'No Event Stream returned by server';
   //SErrRedirectAborted = 'Redirect aborted.';
 
 Const
@@ -722,6 +782,18 @@ begin
     AfterSocketHandlerCreate(Self,Result);
 end;
 
+function TFPCustomHTTPClient.ExtractSocket: TSocketStream;
+begin
+  Result:=FSocket;
+  FSocket:=Nil;
+end;
+
+function TFPCustomHTTPClient.ExtractBuffer: AnsiString;
+begin
+  Result:=FBuffer;
+  FBuffer:='';
+end;
+
 procedure TFPCustomHTTPClient.ConnectToServer(const AHost: String;
   APort: Integer; UseSSL : Boolean = False);
 
@@ -778,9 +850,14 @@ end;
 
 procedure TFPCustomHTTPClient.DisconnectFromServer;
 
+var
+  lSocket : TSocketStream;
+
 begin
-  FreeAndNil(FSocket);
+  lSocket:=ExtractSocket;
+  lSocket.Free;
 end;
+
 function TFPCustomHTTPClient.ProtocolSupported(Protocol: String; out IsSSL: Boolean): Boolean;
 begin
   Result := (Protocol='http') or (Protocol='https');
@@ -791,6 +868,7 @@ function TFPCustomHTTPClient.ReadFromSocket(var Buffer; Count: Longint): Longint
 begin
   Result:=FSocket.Read(Buffer,Count)
 end;
+
 function TFPCustomHTTPClient.WriteToSocket(const Buffer; Count: Longint): Longint;
 begin
   Result:=FSocket.Write(Buffer,Count)
@@ -1137,30 +1215,12 @@ function TFPCustomHTTPClient.CheckContentLength: Int64;
 
 Const CL ='content-length:';
 
-Var
-  S : String;
-  I : integer;
-
 begin
-  Result:=-1;
-  I:=0;
-  While (Result=-1) and (I<FResponseHeaders.Count) do
-    begin
-    S:=Trim(LowerCase(FResponseHeaders[i]));
-    If StartsStr(Cl,S) then
-      begin
-      System.Delete(S,1,Length(CL));
-      Result:=StrToInt64Def(Trim(S),-1);
-      end;
-    Inc(I);
-    end;
+  Result:=StrToIntDef(CheckHeader(CL),-1);
   FContentLength:=Result;
 end;
 
-function TFPCustomHTTPClient.CheckTransferEncoding: string;
-
-Const CL ='transfer-encoding:';
-
+function TFPCustomHTTPClient.CheckHeader(const aHeader : string): string;
 Var
   S : String;
   I : integer;
@@ -1171,9 +1231,9 @@ begin
   While (I<FResponseHeaders.Count) do
     begin
     S:=Trim(LowerCase(FResponseHeaders[i]));
-    If StartsStr(Cl,S) then
+    If StartsStr(aHeader,S) then
       begin
-      System.Delete(S,1,Length(CL));
+      System.Delete(S,1,Length(aHeader));
       Result:=Trim(S);
       exit;
       end;
@@ -1181,6 +1241,24 @@ begin
     end;
 end;
 
+function TFPCustomHTTPClient.CheckTransferEncoding: string;
+
+Const
+  CL ='transfer-encoding:';
+
+begin
+  Result:=CheckHeader(CL);
+end;
+
+function TFPCustomHTTPClient.CheckContentType: string;
+
+Const
+  CL ='content-type:';
+
+begin
+  Result:=CheckHeader(CL);
+end;
+
 procedure TFPCustomHTTPClient.DoVerifyCertificate(Sender: TObject; var Allow: Boolean);
 begin
   If Assigned(FOnVerifyCertificate) then
@@ -1405,7 +1483,9 @@ begin
     Raise EHTTPClient.Create(SErrUnexpectedResponse, ResponseStatusCode);
   if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
     exit;
-  if CompareText(CheckTransferEncoding,'chunked')=0 then
+  if SameText(CheckContentType,'text/event-stream') and HandlesEventStream then
+    StartEventStream
+  else if CompareText(CheckTransferEncoding,'chunked')=0 then
     ReadChunkedResponse
   else
     begin
@@ -1476,6 +1556,34 @@ begin
     AddHeader('Connection', 'close');
 end;
 
+procedure TFPCustomHTTPClient.GetEventSourceHandler(Sender: TObject; aSource: TCustomHTTPEventSource);
+begin
+  FGetEventSource:=aSource;
+end;
+
+function TFPCustomHTTPClient.CreateEventSource(aSocket : TSocketStream; const aBuffer : AnsiString): TCustomHTTPEventSource;
+begin
+  Result:=THTTPEventSource.Create(aSocket,aBuffer);
+end;
+
+procedure TFPCustomHTTPClient.StartEventStream;
+var
+  lSource : TCustomHTTPEventSource;
+  lSocket : TSocketStream;
+  lBuffer : AnsiString;
+begin
+  lBuffer:=ExtractBuffer;
+  lSocket:=ExtractSocket;
+  lSource:=CreateEventSource(lSocket,lBuffer);
+  if HandlesEventStream then
+    FOnEventStream(Self,lSource);
+end;
+
+function TFPCustomHTTPClient.HandlesEventstream: Boolean;
+begin
+  Result:=Assigned(FOnEventStream);
+end;
+
 procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI; const AMethod: string; AStream: TStream;
   const AAllowedResponseCodes: array of Integer; AHeadersOnly, AIsHttps: Boolean);
 Var
@@ -1769,6 +1877,34 @@ begin
   end;
 end;
 
+function TFPCustomHTTPClient.GetEventSource(const aMethod, aURL: String; const aBody: string): TCustomHTTPEventSource;
+
+var
+  lEventSource : THTTPEventStreamHandler;
+  lStream : TStream;
+begin
+  FGetEventSource:=Nil;
+  lEventSource:=OnEventStream;
+  try
+    lStream:=TStringStream.Create;
+    OnEventStream:=@GetEventSourceHandler;
+    if (aBody<>'') and not SameText(aMethod,'GET') then
+      RequestBody:=TStringStream.Create(aBody);
+    DoMethod(aMethod,aURL,lStream,[200,204]);
+    Result:=FGetEventSource;
+    FGetEventSource:=Nil;
+    if not Assigned(Result) then
+      raise EHTTP.Create(SErrNoEventStream);
+    if Assigned(lEventSource) then
+      lEventSource(self,Result);
+
+  finally
+    lStream.Create;
+    OnEventStream:=lEventSource;
+  end;
+
+end;
+
 class function TFPCustomHTTPClient.IsRedirect(ACode: Integer): Boolean;
 begin
   Case ACode of
@@ -2556,6 +2692,156 @@ begin
     end;
 end;
 
+{ TCustomHTTPEventSource }
+
+constructor TCustomHTTPEventSource.Create(aSocket: TSocketStream; const aBuffer: AnsiString);
+begin
+  FTerminated:=False;
+  FHeaders:=TStringList.Create;
+  FHeaders.NameValueSeparator:=':';
+  FSocket:=aSocket;
+  FBuffer:=aBuffer;
+end;
+
+function TCustomHTTPEventSource.DataAvailable: Boolean;
+begin
+  Result:=FSocket.Handler.BytesAvailable<>0;
+end;
+
+function TCustomHTTPEventSource.ReadFromSocket(var aBuffer; aCount: Longint): Longint;
+begin
+  Result:=FSocket.Read(aBuffer,aCount);
+  FEOF:=Result<=0;
+end;
+
+function TCustomHTTPEventSource.ReadString(out S: String): Boolean;
+
+  Function FillBuffer: Boolean;
+
+  Var
+    R : Integer;
+
+  begin
+    if Terminated then
+      Exit(False);
+    SetLength(FBuffer,ReadBufLen);
+    r:=ReadFromSocket(FBuffer[1],ReadBufLen);
+    If (r=0) or Terminated Then
+      Exit(False);
+    If (r<0) then
+      Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
+    if (r<ReadBuflen) then
+      SetLength(FBuffer,r);
+    Result:=r>0;
+  end;
+
+  function FindNewLineChar(aBufLen,StartAt : Integer) : Integer;
+  var
+    lBuf,I : Integer;
+  begin
+    lBuf:=aBufLen;
+    i:=StartAt;
+    While (I<=lbuf) and not (FBuffer[i] in [#10,#13]) Do
+      inc(i);
+    Result:=I;
+  end;
+
+Var
+  lCheck,lFound : boolean;
+  P,lBufLen,lStart : integer;
+
+begin
+  S:='';
+  Result:=False;
+  lCheck:=False;
+  lStart:=1;
+  Repeat
+    lBufLen:=Length(FBuffer);
+    if lBufLen=0 then
+      begin
+      if not FillBuffer then
+        Break;
+      lBufLen:=Length(FBuffer);
+      if lCheck and (lBufLen>0) and (FBuffer[1]=#10) then
+        lStart:=2
+      else
+        lStart:=1;
+      end;
+    P:=FindNewLineChar(lBufLen,lStart);
+    lFound:=P<=lBufLen;
+    S:=S+Copy(FBuffer,lStart,P-lStart);
+    // Check #10 at start of next line ?
+    lCheck:=lFound and (FBuffer[P]=#13) and (P=lBufLen);
+    // if not at EOL, check if next is
+    if lFound and not lCheck then
+      begin
+      if (P<lBufLen) and (FBuffer[P]=#13) and (FBuffer[P+1]=#10) then
+        Inc(P);
+      end;
+    Delete(FBuffer,1,P);
+  until Terminated or lFound;
+  Result:=lFound or (S<>'');
+end;
+
+procedure TCustomHTTPEventSource.Terminate;
+begin
+  FTerminated:=True;
+end;
+
+
+function TCustomHTTPEventSource.ReadEvent(out aEvent: THTTPServerEvent; aConcatData: Boolean): Boolean;
+var
+  lLine, lKey, lValue: string;
+  lCount : integer;
+begin
+  aEvent:=Default(THTTPServerEvent);
+  SetLength(aEvent.Data,1);
+  lCount:=0;
+  Result:=False;
+  While ReadString(lLine) and (lLine<>'') do
+    begin
+    lKey:=ExtractWord(1,lLine,[':']);
+    lValue:=TrimLeft(ExtractWord(2,lLine,[':']));
+    Case lKey of
+      'data' :
+        begin
+        if aConcatData then
+          begin
+          if aEvent.Data[0]<>'' then
+            aEvent.Data[0]:=aEvent.Data[0]+sLineBreak;
+          aEvent.Data[0]:=aEvent.Data[0]+lValue;
+          end
+        else
+          begin
+          if Length(aEvent.Data)=lCount then
+            SetLength(aEvent.Data,lCount+3);
+          aEvent.Data[lCount]:=lValue;
+          inc(lCount);
+          end;
+        Result:=True;
+        end;
+      'id' : aEvent.id:=lValue;
+      'event' : aEvent.Event:=lValue;
+      '': aEvent.Comment:=aEVent.Comment+sLineBreak+lValue;
+      'retry':
+    end
+    end;
+  if not aConcatData then
+    SetLength(aEvent.Data,lCount);
+end;
+
+procedure TCustomHTTPEventSource.Close;
+begin
+  FreeAndNil(FSocket);
+end;
+
+destructor TCustomHTTPEventSource.Destroy;
+begin
+  Close;
+  FreeAndNil(FHeaders);
+  inherited Destroy;
+end;
+
 { EHTTPClient }
 
 constructor EHTTPClient.Create(const AStatusText: String; AStatusCode: Integer);

packages/fcl-web/src/base/fphttpserver.pp

@@ -63,6 +63,10 @@ Type
     Procedure DoSendHeaders(Headers : TStrings); override;
     Procedure DoSendContent; override;
     Property Connection : TFPHTTPConnection Read FConnection;
+  Public
+    procedure StartServerEvents; override;
+    Procedure SendServerEvent(const aEvent : THTTPServerEvent); override;
+    Procedure EndServerEvents; override;
   end;
 
 
@@ -896,7 +900,7 @@ end;
 
 procedure TFPHTTPConnectionResponse.DoSendContent;
 begin
-  if Connection.IsUpgraded then
+  if Connection.IsUpgraded or EventsStarted then
     exit;
   If Assigned(ContentStream) and (ContentStream.Size>0) then
     Connection.Socket.CopyFrom(ContentStream,0)
@@ -905,6 +909,27 @@ begin
       Connection.Socket.WriteBuffer(Content[1],Length(Content));
 end;
 
+procedure TFPHTTPConnectionResponse.StartServerEvents;
+begin
+  CheckServerEvents;
+end;
+
+procedure TFPHTTPConnectionResponse.SendServerEvent(const aEvent: THTTPServerEvent);
+var
+  lEvent : RawByteString;
+begin
+  if not EventsStarted then
+    Raise EHTTPServer.Create('Server side events not started');
+  lEvent:=aEvent.ToString;
+  SetCodePage(lEvent,CP_UTF8); // UTF8 is mandatory
+  Connection.Socket.WriteBuffer(lEvent[1],Length(lEvent));
+end;
+
+procedure TFPHTTPConnectionResponse.EndServerEvents;
+begin
+  inherited EndServerEvents;
+end;
+
 { TFPHTTPConnection }
 
 function TFPHTTPConnection.ReadString : String;

packages/fcl-web/src/base/httpdefs.pp

@@ -23,6 +23,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 {$mode objfpc}
+{$modeswitch advancedrecords}
 {$H+}
 { $DEFINE CGIDEBUG}
 {$IFNDEF FPC_DOTTEDUNITS}
@@ -560,6 +561,18 @@ type
   end;
 
 
+  { THTTPServerEvent }
+
+  THTTPServerEvent = record
+    Id : string;
+    Data : Array of string;
+    Event : string;
+    Comment : string;
+    Retry : integer;
+    // Return formattted event message. Includes terminating newlines.
+    Function ToString : AnsiString;
+  end;
+
   { TResponse }
 
   TResponse = class(THttpHeader)
@@ -573,6 +586,7 @@ type
     FContentSent: Boolean;
     FRequest : TRequest;
     FCookies : TCookies;
+    FEventsStarted : Boolean;
     function GetContent: RawByteString;
     procedure SetContent(const AValue: RawByteString);
     procedure SetContents(AValue: TStrings);
@@ -584,12 +598,17 @@ type
     Procedure DoSendHeaders(Headers : TStrings); virtual; abstract;
     Procedure DoSendContent; virtual; abstract;
     Procedure CollectHeaders(Headers : TStrings); virtual;
+    procedure CheckServerEvents; virtual;
+    property EventsStarted : Boolean Read FEventsStarted;
   public
     constructor Create(ARequest : TRequest); overload;
     destructor destroy; override;
     Procedure SendContent;
     Procedure SendHeaders;
     Procedure SendResponse; // Delphi compatibility
+    procedure StartServerEvents; virtual;
+    Procedure SendServerEvent(const aEvent : THTTPServerEvent); virtual;
+    Procedure EndServerEvents; virtual;
     Procedure SendRedirect(const TargetURL:String);
     Function ToString: RTLstring; override;
     // Set Code and CodeText. Send content if aSend=True
@@ -615,7 +634,7 @@ type
     property Cookies: TCookies read FCookies;
     Property FreeContentStream : Boolean Read FFreeContentStream Write FFreeContentStream;
   end;
-  
+
   { TSessionVariable }
 
 
@@ -777,6 +796,12 @@ Resourcestring
   SErrNoSuchUploadedFile        = 'No such uploaded file : "%s"';
   SErrUnknownCookie             = 'Unknown cookie: "%s"';
   SErrNoRequestMethod           = 'No REQUEST_METHOD passed from server.';
+  SErrServerEventsNotSupported  = 'Server events not supported';
+  SErrCannotStartServerEventsWrongStatus = 'Cannot start server event stream: Status is not 200';
+  SErrCannotStartServerEventsHaveContents = 'Cannot start server event stream: Content already set';
+  SErrCannotStartServerEventsWrongContentType = 'Cannot start server event stream: Content-Type is not text/event-stream';
+  SErrCannotStartServerEventsWrongContentLength = 'Cannot start server event stream: Content-Length is nonzero';
+  SErrCannotStartServerEventsWrongConnection = 'Cannot start server event stream: Connection header is not close';
 
 const
    hexTable = '0123456789ABCDEF';
@@ -2794,6 +2819,34 @@ begin
     FOnStreamEncodingEvent(Self, State, Buf, Size);
 end;
 
+{ THTTPServerEvent }
+
+function THTTPServerEvent.ToString: AnsiString;
+
+  procedure AddToResult(const aName : string; aValue : string; aForce : boolean = false);
+  begin
+    if (aValue='') and not aForce then exit;
+    if Pos(#10,aValue)<>0 then
+      raise EInOutArgumentException.Create('Cannot send strings with embedded newline');
+    if Result<>'' then
+      Result:=Result+#10;
+    Result:=Result+aName+': '+aValue;
+  end;
+
+var
+  lData : string;
+begin
+  Result:='';
+  AddToResult('id',ID);
+  AddToResult('event',Event);
+  for lData in Data do
+    AddToResult('data',lData,True);
+  if Retry<>0 then
+    AddToResult('retry',IntToStr(Retry));
+  AddToResult('',Comment);
+  Result:=Result+#10#10;
+end;
+
 { ---------------------------------------------------------------------
   TUploadedFiles
   ---------------------------------------------------------------------}
@@ -2975,6 +3028,21 @@ begin
   SendContent;
 end;
 
+procedure TResponse.StartServerEvents;
+begin
+  Raise ENotSupportedException.Create(SErrServerEventsNotSupported);
+end;
+
+procedure TResponse.SendServerEvent(const aEvent: THTTPServerEvent);
+begin
+  Raise ENotSupportedException.Create(SErrServerEventsNotSupported);
+end;
+
+procedure TResponse.EndServerEvents;
+begin
+  Raise ENotSupportedException.Create(SErrServerEventsNotSupported);
+end;
+
 
 procedure TResponse.SendRedirect(const TargetURL: String);
 begin
@@ -2991,7 +3059,7 @@ begin
     end;
 end;
 
-function TResponse.ToString: rtlstring;
+function TResponse.ToString: RTLstring;
 begin
   if assigned(Request) then
     Result:=Request.ToString
@@ -3115,6 +3183,42 @@ begin
 {$ifdef cgidebug} SendMethodExit('Collectheaders');{$endif}
 end;
 
+procedure TResponse.CheckServerEvents;
+const
+  CT =  'text/event-stream';
+begin
+  if (Contents.Count>0) or Assigned(ContentStream) then
+    raise EHTTP.Create(SErrCannotStartServerEventsHaveContents);
+  if Code<>200 then
+    begin
+    if HeadersSent then
+      Raise EHTTP.Create(SErrCannotStartServerEventsWrongStatus);
+    Code:=200;
+    CodeText:='OK';
+    end;
+  if (ContentType<>CT) then
+    begin
+    if HeadersSent then
+      Raise EHTTP.Create(SErrCannotStartServerEventsWrongContentType);
+    ContentType:=CT;
+    end;
+  if (ContentLength<>0) then
+    begin
+    if HeadersSent then
+      Raise EHTTP.Create(SErrCannotStartServerEventsWrongContentLength);
+    ContentLength:=0;
+    end;
+  if (Connection<>'') and (Connection<>'close') then
+    begin
+    if HeadersSent then
+      Raise EHTTP.Create(SErrCannotStartServerEventsWrongConnection);
+    Connection:='close';
+    end;
+  if not HeadersSent then
+    SendHeaders;
+  FEventsStarted:=True;
+end;
+
 
 { ---------------------------------------------------------------------
   TCookie