Merge remote-tracking branch 'refs/remotes/origin/openssl'

Demo/Project1.dpr

@@ -0,0 +1,15 @@
+program Project1;
+
+uses
+  Vcl.Forms,
+  Unit1 in 'Unit1.pas' {Form1},
+  superobject in '..\superobject\superobject.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.MainFormOnTaskbar := True;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

Demo/Unit1.dfm

@@ -0,0 +1,41 @@
+object Form1: TForm1
+  Left = 0
+  Top = 0
+  Caption = 'Form1'
+  ClientHeight = 337
+  ClientWidth = 635
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Button1: TButton
+    Left = 8
+    Top = 8
+    Width = 75
+    Height = 25
+    Caption = 'Button1'
+    TabOrder = 0
+    OnClick = Button1Click
+  end
+  object Button2: TButton
+    Left = 8
+    Top = 39
+    Width = 75
+    Height = 25
+    Caption = 'Button2'
+    TabOrder = 1
+    OnClick = Button2Click
+  end
+  object Timer1: TTimer
+    Enabled = False
+    Interval = 5000
+    OnTimer = Timer1Timer
+    Left = 128
+    Top = 16
+  end
+end

Demo/Unit1.pas

@@ -0,0 +1,139 @@
+unit Unit1;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
+  IdServerWebsocketContext;
+
+type
+  TForm1 = class(TForm)
+    Button1: TButton;
+    Timer1: TTimer;
+    Button2: TButton;
+    procedure Button1Click(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
+  private
+    procedure ServerMessageTextReceived(const AContext: TIdServerWSContext; const aText: string);
+    procedure ClientBinDataReceived(const aData: TStream);
+  public
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+uses
+  IdWebsocketServer, IdHTTPWebsocketClient, superobject, IdSocketIOHandling,
+  IdIOHandlerWebsocket;
+
+var
+  server: TIdWebsocketServer;
+  client: TIdHTTPWebsocketClient;
+
+const
+  C_CLIENT_EVENT = 'CLIENT_TO_SERVER_EVENT_TEST';
+  C_SERVER_EVENT = 'SERVER_TO_CLIENT_EVENT_TEST';
+
+procedure ShowMessageInMainthread(const aMsg: string) ;
+begin
+  TThread.Synchronize(nil,
+    procedure
+    begin
+      ShowMessage(aMsg);
+    end);
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  server := TIdWebsocketServer.Create(Self);
+  server.DefaultPort := 12345;
+  server.SocketIO.OnEvent(C_CLIENT_EVENT,
+    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
+    begin
+      //show request (threadsafe)
+      ShowMessageInMainthread('REQUEST: ' + aArgument[0].AsJSon);
+      //send callback (only if specified!)
+      if aCallback <> nil then
+        aCallback.SendResponse( SO(['succes', True]).AsJSon );
+    end);
+  server.Active      := True;
+
+  client := TIdHTTPWebsocketClient.Create(Self);
+  client.Port := 12345;
+  client.Host := 'localhost';
+  client.SocketIOCompatible := True;
+  client.SocketIO.OnEvent(C_SERVER_EVENT,
+    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
+    begin
+      ShowMessageInMainthread('Data PUSHED from server: ' + aArgument[0].AsJSon);
+      //server wants a response?
+      if aCallback <> nil then
+        aCallback.SendResponse('thank for the push!');
+    end);
+  client.Connect;
+  client.SocketIO.Emit(C_CLIENT_EVENT, SO([ 'request', 'some data']),
+    //provide callback
+    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
+    begin
+      //show response (threadsafe)
+      ShowMessageInMainthread('RESPONSE: ' + aJSON.AsJSon);
+    end);
+
+  //start timer so server pushes (!) data to all clients
+  Timer1.Interval := 5 * 1000; //5s
+//  Timer1.Enabled  := True;
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+  server := TIdWebsocketServer.Create(Self);
+  server.DefaultPort := 12346;
+  server.Active      := True;
+
+  client := TIdHTTPWebsocketClient.Create(Self);
+  client.Port := 12346;
+  client.Host := 'localhost';
+  client.Connect;
+  client.UpgradeToWebsocket;
+
+  client.OnBinData     := ClientBinDataReceived;
+  server.OnMessageText := ServerMessageTextReceived;
+  client.IOHandler.Write('test');
+end;
+
+procedure TForm1.ClientBinDataReceived(const aData: TStream);
+begin
+  //
+end;
+
+procedure TForm1.ServerMessageTextReceived(const AContext: TIdServerWSContext; const aText: string);
+var
+  strm: TStringStream;
+begin
+  ShowMessageInMainthread('WS REQUEST: ' + aText);
+  strm := TStringStream.Create('SERVER: ' + aText);
+  AContext.IOHandler.Write(strm, wdtBinary);
+end;
+
+procedure TForm1.Timer1Timer(Sender: TObject);
+begin
+  Timer1.Enabled := false;
+  server.SocketIO.EmitEventToAll(C_SERVER_EVENT, SO(['data', 'pushed from server']),
+    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
+    begin
+        //show response (threadsafe)
+        TThread.Synchronize(nil,
+          procedure
+          begin
+            ShowMessage('RESPONSE from a client: ' + aJSON.AsJSon);
+          end);
+    end);
+end;
+
+end.

IdHTTPWebsocketClient.pas

@@ -625,7 +625,12 @@ begin
     //ws://host:port/<resourcename>
     //about resourcename, see: http://dev.w3.org/html5/websockets/ "Parsing WebSocket URLs"
     //sURL := Format('ws://%s:%d/%s', [Host, Port, WSResourceName]);
+    sURL := Format('https://%s:%d/%s', [Host, Port, WSResourceName]);
+{$IFDEF WS_NO_SSL}
+    //TODO: depend protocol on usessl - param passing in here
     sURL := Format('http://%s:%d/%s', [Host, Port, WSResourceName]);
+{$ENDIF}
+    
     ReadTimeout := Max(5 * 1000, ReadTimeout);
 
     { voorbeeld:

IdIOHandlerWebsocket.pas

@@ -11,6 +11,9 @@ uses
   Classes, SysUtils,
   IdIOHandlerStack, IdGlobal, IdException, IdBuffer,
   SyncObjs,
+{$IFNDEF WS_NO_SSL}
+  IdSSLOpenSSL,
+{$ENDIF}
   Generics.Collections;
 
 type
@@ -22,11 +25,14 @@ type
   TIdIOHandlerWebsocket   = class;
   EIdWebSocketHandleError = class(EIdSocketHandleError);
 
-  {$if CompilerVersion >= 26}   //XE5
-  TIdTextEncoding = IIdTextEncoding;
-  {$ifend}
-
+  {.$if CompilerVersion >= 26}   //XE5
+  //TIdTextEncoding = IIdTextEncoding;
+  {.$ifend}
+{$IFDEF WS_NO_SSL}
   TIdIOHandlerWebsocket = class(TIdIOHandlerStack)
+{ELSE}
+  TIdIOHandlerWebsocketSSL = class(TIdSSLIOHandlerSocketOpenSSL)
+{$ENDIF}
   private
     FIsServerSide: Boolean;
     FBusyUpgrading: Boolean;
@@ -55,12 +61,15 @@ type
     function ReadFrame(out aFIN, aRSV1, aRSV2, aRSV3: boolean; out aDataCode: TWSDataCode; out aData: TIdBytes): Integer;
     function ReadMessage(var aBuffer: TIdBytes; out aDataCode: TWSDataCode): Integer;
 
-    {$if CompilerVersion >= 26}   //XE5
-    function UTF8Encoding: IIdTextEncoding;
-    {$else}
+    {.$if CompilerVersion >= 26}   //XE5
+    //function UTF8Encoding: IIdTextEncoding;
+    {.$else}
     function UTF8Encoding: TEncoding;
-    {$ifend}
+    {.$ifend}
   public
+{$IFNDEF WS_NO_SSL}
+    procedure ClearSSLOptions;
+{$ENDIF}    
     function WriteData(aData: TIdBytes; aType: TWSDataCode;
                         aFIN: boolean = true; aRSV1: boolean = false; aRSV2: boolean = false; aRSV3: boolean = false): integer;
     property BusyUpgrading : Boolean read FBusyUpgrading write FBusyUpgrading;
@@ -258,6 +267,14 @@ begin
   FPendingWriteCount := 0;
 end;
 
+{$IFNDEF WS_NO_SSL}
+procedure TIdIOHandlerWebsocketSSL.ClearSSLOptions;
+begin
+  self.fxSSLOptions.Free;
+  self.fxSSLOptions := nil;
+end;
+{$ENDIF
+
 procedure TIdIOHandlerWebsocket.Close;
 var
   iaWriteBuffer: TIdBytes;
@@ -827,17 +844,17 @@ begin
   FLock.Leave;
 end;
 
-{$if CompilerVersion >= 26}   //XE5
-function TIdIOHandlerWebsocket.UTF8Encoding: IIdTextEncoding;
-begin
-  Result := IndyTextEncoding_UTF8;
-end;
-{$else}
+{.$if CompilerVersion >= 26}   //XE5
+//function TIdIOHandlerWebsocket.UTF8Encoding: IIdTextEncoding;
+//begin
+//  Result := IndyTextEncoding_UTF8;
+//end;
+{.$else}
 function TIdIOHandlerWebsocket.UTF8Encoding: TEncoding;
 begin
   Result := TIdTextEncoding.UTF8;
 end;
-{$ifend}
+{.$ifend}
 
 function TIdIOHandlerWebsocket.ReadFrame(out aFIN, aRSV1, aRSV2, aRSV3: boolean;
                                          out aDataCode: TWSDataCode; out aData: TIdBytes): Integer;
@@ -1131,10 +1148,11 @@ begin
 
     AppendBytes(bData, aData);   //important: send all at once!
     ioffset := 0;
+    iDataLength := Length(bData);
     repeat
-      Result := Binding.Send(bData, ioffset);
+      result := inherited WriteDataToTarget(bdata,iOffset, (iDataLength-ioffset));
       Inc(ioffset, Result);
-    until ioffset >= Length(bData);
+    until ioffset >= iDataLenght;
 
 //    if debughook > 0 then
 //      OutputDebugString(PChar(Format('Written (TID:%d, P:%d): %s',

IdServerIOHandlerWebsocket.pas

@@ -5,10 +5,18 @@ interface
 uses
   Classes,
   IdServerIOHandlerStack, IdIOHandlerStack, IdGlobal, IdIOHandler, IdYarn, IdThread, IdSocketHandle,
+{$IFNDEF WS_NO_SSL}
+  IdSSLOpenSSL, 
+  sysutils,
+{$ENDIF}
   IdIOHandlerWebsocket;
 
 type
+{$IFNDEF WS_NO_SSL}
   TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack)
+{$ELSE}
+  TIdServerIOHandlerWebsocket = class(TIdServerIOHandlersslOpenSSL)
+{$ENDIF}
   protected
     procedure InitComponent; override;
   public
@@ -23,8 +31,40 @@ implementation
 
 function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
   AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
+{$IFNDEF WS_NO_SSL}
+var
+  LIO: TIdIOHandlerWebsocketSSL;
+{$ENDIF}
 begin
+{$IFDEF WS_NO_SSL}
   Result := inherited Accept(ASocket, AListenerThread, AYarn);
+{$ELSE}
+  Assert(ASocket<>nil);
+  Assert(fSSLContext<>nil);
+  LIO := TIdIOHandlerWebsocket.Create(nil);
+  try
+    LIO.PassThrough := True;
+    LIO.Open;
+    if LIO.Binding.Accept(ASocket.Handle) then
+    begin
+      //we need to pass the SSLOptions for the socket from the server
+      LIO.ClearSSLOptions;
+      LIO.IsPeer := True;
+      LIO.SSLOptions := SSLOptions;
+      LIO.SSLSocket := TIdSSLSocket.Create(Self);
+      LIO.SSLContext := fSSLContext;
+
+    end 
+    else 
+    begin
+      FreeAndNil(LIO);
+    end;
+  except
+    LIO.Free;
+    raise;
+  end;
+  Result := LIO;
+{$ENDIF}
   if Result <> nil then
   begin
     (Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
@@ -35,6 +75,7 @@ end;
 procedure TIdServerIOHandlerWebsocket.InitComponent;
 begin
   inherited InitComponent;
+//TODO: Check if this is necessary for SSL
   IOHandlerSocketClass := TIdIOHandlerWebsocket;
 end;
 

IdServerWebsocketHandling.pas

@@ -137,7 +137,9 @@ begin
           aSocketIOHandler.WritePing(context);
         end
         else
+        begin
           context.IOHandler.WriteData(nil, wdcPing);
+        end;
       end;
 
     end;
@@ -325,13 +327,22 @@ begin
       hash.Free;
     end;
     AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Accept'] := sValue;
-
+{$IFNDEF WS_NO_SSL}
+    //keep alive the ssl connection
+    AResponseInfo.CustomHeaders.Values['Keep-alive'] := 'true';
+{$ENDIF}
+        
     //send same protocol back?
     AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Protocol']   := context.WebSocketProtocol;
     //we do not support extensions yet (gzip deflate compression etc)
     //AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Extensions'] := context.WebSocketExtensions;
     //http://www.lenholgate.com/blog/2011/07/websockets---the-deflate-stream-extension-is-broken-and-badly-designed.html
     //but is could be done using idZlib.pas and DecompressGZipStream etc
+{$IFNDEF WS_NO_SSL}
+    //YD: TODO: Check if this is really necessary
+    AResponseInfo.CustomHeaders.Values['sec-websocket-extensions']   := '';
+    context.WebSocketExtensions := '';
+{$ENDIF}
 
     //send response back
     context.IOHandler.InputBuffer.Clear;

IdWebsocketServer.pas

@@ -4,7 +4,7 @@ interface
 
 uses
   IdServerWebsocketHandling, IdServerSocketIOHandling, IdServerWebsocketContext,
-  IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket;
+  IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket, IdServerIOHandler;
 
 type
   TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string)  of object;
@@ -43,7 +43,12 @@ type
 implementation
 
 uses
-  IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows, IdWinsock2;
+  IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows, 
+{$IFNDEF WS_NO_SSL}  
+  idIOHandler, 
+  idssl,
+{$ENDIF}
+  IdWinsock2;
 
 { TIdWebsocketServer }
 

README.md

@@ -0,0 +1,81 @@
+# DelphiWebsockets
+Websockets and Socket.io for Delphi
+
+See below for an event driven async example of an socket.io server and client:
+```delphi
+uses
+  IdWebsocketServer, IdHTTPWebsocketClient, superobject, IdSocketIOHandling;
+
+var
+  server: TIdWebsocketServer;
+  client: TIdHTTPWebsocketClient;
+
+const
+  C_CLIENT_EVENT = 'CLIENT_TO_SERVER_EVENT_TEST';
+  C_SERVER_EVENT = 'SERVER_TO_CLIENT_EVENT_TEST';
+
+procedure ShowMessageInMainthread(const aMsg: string) ;
+begin
+  TThread.Synchronize(nil,
+    procedure
+    begin
+      ShowMessage(aMsg);
+    end);
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  server := TIdWebsocketServer.Create(Self);
+  server.DefaultPort := 12345;
+  server.SocketIO.OnEvent(C_CLIENT_EVENT,
+    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
+    begin
+      //show request (threadsafe)
+      ShowMessageInMainthread('REQUEST: ' + aArgument[0].AsJSon);
+      //send callback (only if specified!)
+      if aCallback <> nil then
+        aCallback.SendResponse( SO(['succes', True]).AsJSon );
+    end);
+  server.Active      := True;
+
+  client := TIdHTTPWebsocketClient.Create(Self);
+  client.Port := 12345;
+  client.Host := 'localhost';
+  client.SocketIOCompatible := True;
+  client.SocketIO.OnEvent(C_SERVER_EVENT,
+    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
+    begin
+      ShowMessageInMainthread('Data PUSHED from server: ' + aArgument[0].AsJSon);
+      //server wants a response?
+      if aCallback <> nil then
+        aCallback.SendResponse('thank for the push!');
+    end);
+  client.Connect;
+  client.SocketIO.Emit(C_CLIENT_EVENT, SO([ 'request', 'some data']),
+    //provide callback
+    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
+    begin
+      //show response (threadsafe)
+      ShowMessageInMainthread('RESPONSE: ' + aJSON.AsJSon);
+    end);
+
+  //start timer so server pushes (!) data to all clients
+  Timer1.Interval := 5 * 1000; //5s
+  Timer1.Enabled  := True;
+end;
+
+procedure TForm1.Timer1Timer(Sender: TObject);
+begin
+  Timer1.Enabled := false;
+  server.SocketIO.EmitEventToAll(C_SERVER_EVENT, SO(['data', 'pushed from server']),
+    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
+    begin
+        //show response (threadsafe)
+        TThread.Synchronize(nil,
+          procedure
+          begin
+            ShowMessage('RESPONSE from a client: ' + aJSON.AsJSon);
+          end);
+    end);
+end;
+```