UDP scan to find servers running on your LAN, even without an interne…

…t connection

git-svn-id: svn://localhost/trunk@6234 a386ff7f-d321-c144-bb17-e251d28fee14

KaM_Remake.dpr

@@ -147,6 +147,9 @@ uses
   KM_NetServer in 'src\KM_NetServer.pas',
   {$IFDEF WDC} KM_NetServerOverbyte in 'src\KM_NetServerOverbyte.pas', {$ENDIF}
   {$IFDEF FPC} KM_NetServerLNet in 'src\KM_NetServerLNet.pas', {$ENDIF}
+  KM_NetUDP in 'src\KM_NetUDP.pas',
+  {$IFDEF WDC} KM_NetUDPOverbyte in 'src\KM_NetUDPOverbyte.pas', {$ENDIF}
+  {$IFDEF FPC} KM_NetUDPLNet in 'src\KM_NetUDPLNet.pas', {$ENDIF}
   KM_Networking in 'src\KM_Networking.pas',
   KM_NetworkClasses in 'src\KM_NetworkClasses.pas',
   KM_NetworkTypes in 'src\KM_NetworkTypes.pas',

Todo/Buglist.txt

@@ -99,6 +99,7 @@ Improvements:
  +	L	The story message on campaign map minimizes instead of jumping annoyingly
  +	L	Unlocked campaign map flags have numbers so you can find a mission easily
  +	M	Ability to return to the lobby (by vote) after the game has started in multiplayer
+ +	M	Servers running on the local area network are detected and listed at the top of the server list
 		Dismiss button to make units walk into the school and disappear (gold is not refunded)
 	L	Simple dedicated server form which lets you set the properties of the INI for the server and start it [gemGreg]
 	L	Placing houses in MP should put a temp/fake visual markup until the real one can be added to make it appear responsive

src/KM_DedicatedServer.pas

@@ -4,14 +4,15 @@ interface
 uses
   SysUtils, Classes, Math,
   {$IFDEF MSWindows}Windows,{$ENDIF}
-  KM_NetServer, KM_MasterServer, KM_CommonTypes, KM_Defaults;
+  KM_NetServer, KM_MasterServer, KM_NetUDP, KM_CommonTypes, KM_Defaults;
 
 type
   TKMDedicatedServer = class
   private
     fLastPing, fLastAnnounce: cardinal;
     fNetServer: TKMNetServer;
     fMasterServer: TKMMasterServer;
+    fUDPAnnounce: TKMNetUDPAnnounce;
     fOnMessage: TUnicodeStringEvent;
     fPublishServer: boolean;
     fAnnounceInterval: word;
@@ -54,6 +55,9 @@ constructor TKMDedicatedServer.Create(aMaxRooms, aKickTimeout, aPingInterval, aA
   fNetServer := TKMNetServer.Create(aMaxRooms, aKickTimeout, aHTMLStatusFile, aWelcomeMessage);
   fMasterServer := TKMMasterServer.Create(aMasterServerAddress, aDedicated);
   fMasterServer.OnError := MasterServerError;
+  fUDPAnnounce := TKMNetUDPAnnounce.Create;
+  fUDPAnnounce.OnError := StatusMessage;
+
   fAnnounceInterval := Max(MINIMUM_ANNOUNCE_INTERVAL, aAnnounceInterval);
   fPingInterval := aPingInterval;
   fLastPing := 0;
@@ -65,6 +69,7 @@ destructor TKMDedicatedServer.Destroy;
 begin
   fNetServer.Free;
   fMasterServer.Free;
+  fUDPAnnounce.Free;
   StatusMessage('Server destroyed');
   inherited;
 end;
@@ -76,14 +81,16 @@ procedure TKMDedicatedServer.Start(const aServerName: UnicodeString; const aPort
   fServerName := aServerName;
   fPublishServer := aPublishServer;
   fNetServer.OnStatusMessage := StatusMessage;
-  fNetServer.StartListening(fPort, aServerName);
+  fNetServer.StartListening(fPort, fServerName);
+  fUDPAnnounce.StartAnnouncing(fPort, fServerName);
 end;
 
 
 procedure TKMDedicatedServer.Stop;
 begin
   fNetServer.StopListening;
   fNetServer.ClearClients;
+  fUDPAnnounce.StopAnnouncing;
   StatusMessage('Stopped listening');
 end;
 
@@ -93,6 +100,7 @@ procedure TKMDedicatedServer.UpdateState;
 begin
   fNetServer.UpdateStateIdle;
   fMasterServer.UpdateStateIdle;
+  fUDPAnnounce.UpdateStateIdle;
 
   if not fNetServer.Listening then Exit; //Do not measure pings or announce the server if we are not listening
 

src/KM_NetUDP.pas

@@ -0,0 +1,205 @@
+unit KM_NetUDP;
+{$I KaM_Remake.inc}
+interface
+uses Classes, Math, SysUtils, KM_CommonClasses, KM_Defaults
+  {$IFDEF WDC} ,KM_NetUDPOverbyte {$ENDIF}
+  {$IFDEF FPC} ,KM_NetUDPLNet {$ENDIF}
+  ;
+
+
+type
+  TNotifyServerDetectedEvent = procedure(const aAddress: string; const aPort: string; const aName: string) of object;
+
+  TKMNetUDP = class
+  private
+    {$IFDEF WDC} fUDP: TKMNetUDPOverbyte; {$ENDIF}
+    {$IFDEF FPC} fUDP: TKMNetUDPLNet;     {$ENDIF}
+
+    fOnError: TGetStrProc;
+    procedure Receive(aAddress: string; aData:pointer; aLength:cardinal); virtual; abstract;
+    procedure Error(const msg: string);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure UpdateStateIdle;
+    property OnError:TGetStrProc write fOnError;
+  end;
+
+  TKMNetUDPAnnounce = class(TKMNetUDP)
+  private
+    fGamePort, fServerName: string;
+    procedure Receive(aAddress: string; aData:pointer; aLength:cardinal); override;
+  public
+    procedure StartAnnouncing(const aGamePort: string; const aName: string);
+    procedure StopAnnouncing;
+  end;
+
+  TKMNetUDPScan = class(TKMNetUDP)
+  private
+    fOnServerDetected: TNotifyServerDetectedEvent;
+    procedure Receive(aAddress: string; aData:pointer; aLength:cardinal); override;
+  public
+    procedure ScanForServers;
+    procedure TerminateScan;
+    property OnServerDetected:TNotifyServerDetectedEvent write fOnServerDetected;
+  end;
+
+
+implementation
+
+
+constructor TKMNetUDP.Create;
+begin
+  Inherited Create;
+  {$IFDEF WDC} fUDP := TKMNetUDPOverbyte.Create; {$ENDIF}
+  {$IFDEF FPC} fUDP := TKMNetUDPLNet.Create;     {$ENDIF}
+  fUDP.OnError := Error;
+  fUDP.OnRecieveData := Receive;
+end;
+
+
+destructor TKMNetUDP.Destroy;
+begin
+  if fUDP<>nil then fUDP.Free;
+  Inherited;
+end;
+
+
+procedure TKMNetUDP.Error(const msg: string);
+begin
+  if Assigned(fOnError) then fOnError(msg);
+end;
+
+
+procedure TKMNetUDP.UpdateStateIdle;
+begin
+  {$IFDEF FPC} fUDP.UpdateStateIdle; {$ENDIF}
+end;
+
+
+{ TKMNetUDPAnnounce }
+procedure TKMNetUDPAnnounce.StartAnnouncing(const aGamePort: string; const aName: string);
+begin
+  fGamePort := aGamePort;
+  fServerName := aName;
+  fUDP.StopListening;
+  try
+    fUDP.Listen('56789');
+  except
+    //UDP announce is not that important, and will fail whenever you start more than 1 server per machine
+    on E: Exception do
+      if Assigned(fOnError) then fOnError('UDP listen for local server detection failed to start: '+E.Message);
+  end;
+end;
+
+
+procedure TKMNetUDPAnnounce.StopAnnouncing;
+begin
+  fUDP.StopListening;
+end;
+
+
+procedure TKMNetUDPAnnounce.Receive(aAddress: string; aData:pointer; aLength:cardinal);
+var
+  M: TKMemoryStream;
+  S: AnsiString;
+  I: Integer;
+begin
+  try
+    M := TKMemoryStream.Create;
+    M.WriteBuffer(aData^, aLength);
+    M.Position := 0;
+
+    //Check header
+    M.ReadA(S);
+    if S <> 'KaM Remake' then Exit;
+    M.ReadA(S);
+    if S <> NET_PROTOCOL_REVISON then Exit;
+
+    //Only care about scan packets
+    M.ReadA(S);
+    if S <> 'scan' then Exit;
+
+    //Send a response to this scanner
+    M.Free;
+    M := TKMemoryStream.Create;
+    M.WriteA('KaM Remake');
+    M.WriteA(NET_PROTOCOL_REVISON);
+    M.WriteA('announce');
+    M.WriteA(fGamePort);
+    M.WriteA(fServerName);
+
+    fUDP.SendPacket(aAddress, '56788', M.Memory, M.Size);
+  finally
+    M.Free;
+  end;
+end;
+
+
+{ TKMNetUDPDetect }
+procedure TKMNetUDPScan.ScanForServers;
+var
+  M: TKMemoryStream;
+begin
+  try
+    //Prepare to receive responses
+    fUDP.StopListening;
+    try
+      fUDP.Listen('56788');
+    except
+      //UDP scan is not that important, and could fail during debugging if running two KaM Remake instances
+      on E: Exception do
+      begin
+        if Assigned(fOnError) then fOnError('UDP scan failed to listen: '+E.Message);
+        Exit;
+      end;
+    end;
+
+    M := TKMemoryStream.Create;
+    M.WriteA('KaM Remake');
+    M.WriteA(NET_PROTOCOL_REVISON);
+    M.WriteA('scan');
+    //Broadcast
+    fUDP.SendPacket('255.255.255.255', '56789', M.Memory, M.Size);
+
+  finally
+    M.Free;
+  end;
+end;
+
+
+procedure TKMNetUDPScan.TerminateScan;
+begin
+  fUDP.StopListening;
+end;
+
+
+procedure TKMNetUDPScan.Receive(aAddress: string; aData:pointer; aLength:cardinal);
+var
+  M: TKMemoryStream;
+  S, ServerPort, ServerName: AnsiString;
+begin
+  try
+    M := TKMemoryStream.Create;
+    M.WriteBuffer(aData^, aLength);
+    M.Position := 0;
+
+    M.ReadA(S);
+    if S <> 'KaM Remake' then Exit;
+    M.ReadA(S);
+    if S <> NET_PROTOCOL_REVISON then Exit;
+    //Only care about announce packets
+    M.ReadA(S);
+    if S <> 'announce' then Exit;
+
+    //Read the server's game port and report it
+    M.ReadA(ServerPort);
+    M.ReadA(ServerName);
+    fOnServerDetected(aAddress, ServerPort, ServerName);
+  finally
+    M.Free;
+  end;
+end;
+
+
+end.

src/KM_NetUDPLNet.pas

@@ -0,0 +1,98 @@
+unit KM_NetUDPLNet;
+{$I KaM_Remake.inc}
+interface
+uses Classes, Math, SysUtils, LNet;
+
+
+type
+  TNotifyAddressDataEvent = procedure(aAddress: string; aData:pointer; aLength:cardinal)of object;
+
+  TKMNetUDPLNet = class
+  private
+    fUDP:TLUdp;
+
+    fOnError: TGetStrProc;
+    fOnRecieveData: TNotifyAddressDataEvent;
+    procedure Receive(aSocket: TLSocket);
+    procedure Error(const msg: string; aSocket: TLSocket);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure SendPacket(const aAddress:string; const aPort:string; aData:pointer; aLength:cardinal);
+    procedure Listen(const aPort: string);
+    procedure StopListening;
+    procedure UpdateStateIdle;
+    property OnError:TGetStrProc write fOnError;
+    property OnRecieveData:TNotifyAddressDataEvent write fOnRecieveData;
+  end;
+
+
+implementation
+
+
+constructor TKMNetUDPLNet.Create;
+begin
+  Inherited Create;
+  fUDP := TLUdp.Create(nil);
+  fUDP.OnError := Error;
+  fUDP.Timeout := 1;
+end;
+
+
+destructor TKMNetUDPLNet.Destroy;
+begin
+  if fUDP<>nil then fUDP.Free;
+  Inherited;
+end;
+
+
+procedure TKMNetUDPLNet.Listen(const aPort:string);
+begin
+  fUDP.OnReceive := Receive;
+  fUDP.Listen(StrToInt(aPort));
+  fUDP.CallAction;
+end;
+
+
+procedure TKMNetUDPLNet.StopListening;
+begin
+  fUDP.Disconnect;
+  fUDP.OnReceive := nil;
+end;
+
+
+procedure TKMNetUDPLNet.SendPacket(const aAddress:string; const aPort:string; aData:pointer; aLength:cardinal);
+begin
+  fUDP.Send(aData^, aLength, aAddress+':'+aPort);
+end;
+
+
+procedure TKMNetUDPLNet.Receive(aSocket: TLSocket);
+const
+  BufferSize = 10240; //10kb
+var
+  P:pointer; s:string;
+  L:integer; //L could be -1 when no data is available
+begin
+  GetMem(P, BufferSize+1); //+1 to avoid RangeCheckError when L = BufferSize
+  L := fUDP.Get(P^, BufferSize, aSocket);
+
+  if L > 0 then //if L=0 then exit;
+    fOnRecieveData(aSocket.PeerAddress, P, L);
+
+  FreeMem(P);
+end;
+
+
+procedure TKMNetUDPLNet.Error(const msg: string; aSocket: TLSocket);
+begin
+  fOnError('LNet UDP Error: '+msg);
+end;
+
+
+procedure TKMNetUDPLNet.UpdateStateIdle;
+begin
+  if fUDP <> nil then fUDP.CallAction; //Process network events
+end;
+
+end.