SSL merge fixes (in XE10.1)

Demo/Unit1.dfm

@@ -16,18 +16,18 @@ object Form1: TForm1
   object Button1: TButton
     Left = 8
     Top = 8
-    Width = 75
+    Width = 121
     Height = 25
-    Caption = 'Button1'
+    Caption = 'Socket.IO test'
     TabOrder = 0
     OnClick = Button1Click
   end
   object Button2: TButton
     Left = 8
     Top = 39
-    Width = 75
+    Width = 121
     Height = 25
-    Caption = 'Button2'
+    Caption = 'Plain websocket test'
     TabOrder = 1
     OnClick = Button2Click
   end

Demo/Unit1.pas

@@ -92,6 +92,9 @@ end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 begin
+  client.Free;
+  server.Free;
+
   server := TIdWebsocketServer.Create(Self);
   server.DefaultPort := 12346;
   server.Active      := True;

IdHTTPWebsocketClient.pas

@@ -619,7 +619,13 @@ 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]);
+{$IFDEF WEBSOCKETSSL}
+    sURL := Format('https://%s:%d/%s', [Host, Port, WSResourceName]);
+{$ELSE}
+    //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

@@ -76,6 +76,9 @@ type
     {$ifend}
     procedure InitComponent; override;
   public
+    {$IFDEF WEBSOCKETSSL}
+    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;
@@ -301,6 +304,14 @@ begin
   FPendingWriteCount := 0;
 end;
 
+{$IFDEF WEBSOCKETSSL}
+procedure TIdIOHandlerWebsocket.ClearSSLOptions;
+begin
+  self.fxSSLOptions.Free;
+  self.fxSSLOptions := nil;
+end;
+{$ENDIF}
+
 procedure TIdIOHandlerWebsocket.Close;
 var
   iaWriteBuffer: TIdBytes;
@@ -592,7 +603,9 @@ begin
 end;
 
 function TIdIOHandlerWebsocket.WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer;
-var data: TIdBytes; DataCode:TWSDataCode; fin:boolean;
+var
+  //data: TIdBytes;
+  DataCode:TWSDataCode; fin:boolean;
 begin
   if UseSingleWriteThread and IsWebsocket and (GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then
     Assert(False, 'Write done in different thread than TIdWebsocketWriteThread!');
@@ -611,17 +624,15 @@ begin
     end
     else
     begin
-      data := ToBytes(ABuffer, ALength, AOffset);
       {$IFDEF DEBUG_WS}
       if Debughook > 0 then
         OutputDebugString(PChar(Format('Send (ws, TID:%d, P:%d): %s',
-                                       [getcurrentthreadid, Self.Binding.PeerPort, BytesToStringRaw(data)])));
-
+                                       [getcurrentthreadid, Self.Binding.PeerPort, BytesToStringRaw(ABuffer)])));
       {$ENDIF}
       try
         DataCode := fPayloadInfo.aDataCode;
         fin := fPayloadInfo.DecLength(ALength);
-        Result := WriteData(data, DataCode, fin,webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits);
+        Result := WriteData(ABuffer, DataCode, fin,webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits);
       except
         FClosedGracefully := True;
         Result := -1;
@@ -1166,10 +1177,9 @@ 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, (Length(bData) - ioffset));  //ssl compatible?
+      result := inherited WriteDataToTarget(bdata,iOffset, (iDataLength-ioffset));
       if Result<0 then
         begin
          // IO error ; probably connexion closed by peer on protocol error ?
@@ -1180,7 +1190,7 @@ begin
          break;
        end;
       Inc(ioffset, Result);
-    until ioffset >= Length(bData);
+    until ioffset >= iDataLength;
 
 //    if debughook > 0 then
 //      OutputDebugString(PChar(Format('Written (TID:%d, P:%d): %s',

IdServerIOHandlerWebsocket.pas

@@ -2,7 +2,7 @@ unit IdServerIOHandlerWebsocket;
 interface
 {$I wsdefines.pas}
 uses
-  Classes
+  Classes, SysUtils
   , IdServerIOHandlerStack
   , IdIOHandlerStack
   , IdGlobal
@@ -26,7 +26,11 @@ type
   protected
     procedure InitComponent; override;
     {$IFDEF WEBSOCKETSSL}
+    {$if CompilerVersion >= 31}   //XE10
+    function GetIOHandlerSelf: TIdSSLIOHandlerSocketOpenSSL;
+    {$else}
     function CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL; override;
+    {$endif}
     {$ENDIF}
   public
     function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread;
@@ -39,16 +43,55 @@ implementation
 { TIdServerIOHandlerStack_Websocket }
 
 {$IFDEF WEBSOCKETSSL}
+  {$if CompilerVersion >= 31}   //XE10
+function TIdServerIOHandlerWebsocket.GetIOHandlerSelf:TIdSSLIOHandlerSocketOpenSSL;
+begin
+  Result := TIdIOHandlerWebsocket.Create(nil);
+end;
+  {$else}
 function TIdServerIOHandlerWebsocket.CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL;
 begin
   Result := TIdIOHandlerWebsocket.Create(nil);
 end;
+  {$endif}
 {$ENDIF}
 
 function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
   AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
+{$IFDEF WEBSOCKETSSL}
+var
+  LIO: TIdIOHandlerWebsocket;
+{$ENDIF}
 begin
+{$IFnDEF WEBSOCKETSSL}
   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

IdServerWebsocketHandling.pas

@@ -95,7 +95,7 @@ begin
 
           strmRequest.Position := 0;
           //first is the type: text or bin
-          wscode := TWSDataCode(context.IOHandler.ReadLongWord);
+          wscode := TWSDataCode(context.IOHandler.ReadUInt32); //ReadLongWord);
           //then the length + data = stream
           context.IOHandler.ReadStream(strmRequest);
           strmRequest.Position := 0;
@@ -138,7 +138,9 @@ begin
           aSocketIOHandler.WritePing(context);
         end
         else
+        begin
           context.IOHandler.WriteData(nil, wdcPing);
+        end;
       end;
 
     end;
@@ -332,13 +334,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;

wsdefines.pas

@@ -1,3 +1,3 @@
-{ $DEFINE WEBSOCKETSSL}
-{ $DEFINE WEBSOCKETBRIDGE}
+{$DEFINE WEBSOCKETSSL}
+{.$DEFINE WEBSOCKETBRIDGE}
 {$DEFINE SUPEROBJECT}