diff --git a/Demo/Project1.dpr b/Demo/Project1.dpr new file mode 100644 index 0000000..bc36be6 --- /dev/null +++ b/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. diff --git a/Demo/Unit1.dfm b/Demo/Unit1.dfm new file mode 100644 index 0000000..2b57e00 --- /dev/null +++ b/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 diff --git a/Demo/Unit1.pas b/Demo/Unit1.pas new file mode 100644 index 0000000..539c218 --- /dev/null +++ b/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. diff --git a/IdHTTPWebsocketClient.pas b/IdHTTPWebsocketClient.pas index 83ba9ed..70e5435 100644 --- a/IdHTTPWebsocketClient.pas +++ b/IdHTTPWebsocketClient.pas @@ -625,7 +625,12 @@ begin //ws://host:port/ //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: diff --git a/IdIOHandlerWebsocket.pas b/IdIOHandlerWebsocket.pas index 19fc06c..642684c 100644 --- a/IdIOHandlerWebsocket.pas +++ b/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', diff --git a/IdServerIOHandlerWebsocket.pas b/IdServerIOHandlerWebsocket.pas index 80e1061..f863847 100644 --- a/IdServerIOHandlerWebsocket.pas +++ b/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; diff --git a/IdServerWebsocketHandling.pas b/IdServerWebsocketHandling.pas index f1f6f52..28ebd68 100644 --- a/IdServerWebsocketHandling.pas +++ b/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; diff --git a/IdWebsocketServer.pas b/IdWebsocketServer.pas index 4062c8c..980d0ab 100644 --- a/IdWebsocketServer.pas +++ b/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 } diff --git a/README.md b/README.md new file mode 100644 index 0000000..6cab6e8 --- /dev/null +++ b/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; +```