AdaLobby/ada_lobby_bot.adb

with Ada.Calendar;
with Ada.Environment_Variables;
with Ada.Exceptions;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.IO_Exceptions;
with Ada.Streams;
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with GNAT.MD5;
with GNAT.Sockets;
with ACL_Utils;

use type Ada.Streams.Stream_Element_Count;

procedure Ada_Lobby_Bot is
   package ATIO renames Ada.Text_IO;

   -- Direct conversion not possible... yes, sometimes Ada gets in the way...
   function To_String (Input : GNAT.MD5.Binary_Message_Digest) return String is
      Output : String (1 .. Input'Length);
      Output_Index : Positive := Output'First;
   begin
      for Input_Index in Input'Range loop
         Output (Output_Index) := Character'Val (Integer (Input (Input_Index)));
         Output_Index := Output_Index + 1;
      end loop;

      return Output;
   end To_String;


   function Get_Environment_Value (Name: String) return String is
   begin
      return Ada.Environment_Variables.Value (Name);
   exception
      when CONSTRAINT_ERROR =>
         raise CONSTRAINT_ERROR with "Required environment variable '" & Name & "' does not exist";
   end Get_Environment_Value;

   -- Sockets part
   package GS renames Gnat.Sockets;
   package ASU renames Ada.Strings.Unbounded;

   Username     : constant String := Get_Environment_Value ("USERNAME");
   Raw_Password : constant String := Get_Environment_Value ("PASSWORD");
   -- password needs to be base64(md5(raw_password))
   Password     : constant String := ACL_Utils.To_Base64 (To_String (GNAT.MD5.Digest (Raw_Password)));

   Client  : GS.Socket_Type;
   Address : GS.Sock_Addr_Type;
   Channel : GS.Stream_Access;

   function Get_Line (Stream : in GNAT.Sockets.Stream_Access) return ASU.Unbounded_String is
      Ustring : ASU.Unbounded_String := ASU.Null_Unbounded_String;
      Ch      : Character;
   begin
      loop
         Ch := Character'Input (Stream);
         exit when Ch = ASCII.LF;
         ASU.Append (Source => Ustring, New_Item => Ch);
      end loop;

      return Ustring;
   end Get_Line;


   use Ada.Calendar;
   PING_Period    : constant Duration := 30.0;
   Next_PING_Time : Time := Clock + PING_Period;

   Line : ASU.Unbounded_String;

   Flood_Cooldown_Period  : constant Duration := 1.0;
   Next_Message_Send_Time : Time := Clock;
   procedure Send_Message_To_Server (Channel: in GNAT.Sockets.Stream_Access; Message: String) is
      New_Line_String : constant String := (1 => ASCII.LF);
   begin
      delay until Next_Message_Send_Time;
      ATIO.Put_Line ("server <= '" & Message & "'");
      String'Write (Channel, Message & New_Line_String);
      Next_PING_Time := Clock + PING_Period;
      Next_Message_Send_Time := Clock + Flood_Cooldown_Period;
   end Send_Message_To_Server;



   type Spring_Lobby_Command_ID_Type is (
      ACCEPTED,
      BATTLEOPENED,
      DENIED,
      LOGININFOEND,
      SAID,
      SAIDPRIVATE,
      TASSERVER
   );
   type    Spring_Lobby_Battle_Type          is (Normal_Battle, Battle_Replay);
   subtype Spring_Lobby_Map_Hash_Type        is Integer range -2**31 .. (2**31-1);
   type    Spring_Lobby_NAT_Traversal_Type   is (None, Hole_Punching, Fixed_Source_Ports);
   type    Spring_Lobby_Passworded_Flag_Type is (False, True);
   type    Spring_Lobby_Server_Mode_Type     is (Normal_Mode, LAN_Mode);


   function To_String (Command_ID : Spring_Lobby_Command_ID_Type) return String is
   begin
      case Command_ID is
      when ACCEPTED           => return "ACCEPTED";
      when BATTLEOPENED       => return "BATTLEOPENED";
      when DENIED             => return "DENIED";
      when LOGININFOEND       => return "LOGININFOEND";
      when SAID               => return "SAID";
      when SAIDPRIVATE        => return "SAIDPRIVATE";
      when TASSERVER          => return "TASServer";
      end case;
   end To_String;
   -----------------------------------------------------------------------------------------------
   -------------------------- SpringRTS Lobby Server Command Handlers  ---------------------------
   -----------------------------------------------------------------------------------------------
   procedure Process_ACCEPTED (User_Name : String) is
   begin
      null;
   end Process_ACCEPTED;


   procedure Process_BATTLEOPENED (
                                   Battle_ID   : String;
                                   Battle_Type : Spring_Lobby_Battle_Type;
                                   NAT_Type    : Spring_Lobby_NAT_Traversal_Type;
                                   Founder     : String;
                                   IP          : String;
                                   Port        : String;
                                   Max_Players : String;
                                   Passworded  : Spring_Lobby_Passworded_Flag_Type;
                                   Rank        : String;
                                   Map_Hash    : Spring_Lobby_Map_Hash_Type;
                                   Map_Name    : String;
                                   Title       : String;
                                   Game_Name   : String
                                  ) is
   begin
      null;
   end Process_BATTLEOPENED;


   procedure Process_DENIED (Reason : String) is
   begin
      ATIO.Put_Line ("DENIED Server login with this user account and password: '" & Reason & "', terminating!");
      Send_Message_To_Server (Channel, "EXIT due to login DENIED");
   end Process_DENIED;


   procedure Process_LOGININFOEND is
   begin
      -- I have received all the server-sent spam, now it is my turn!
      Send_Message_To_Server (Channel, "JOIN s44games");
      Send_Message_To_Server (Channel, "JOIN main");
   end Process_LOGININFOEND;


   procedure Process_SAID (Channel_Name : String; User_Name : String; Text : String) is
   begin
      ATIO.Put_Line ("SAID: " & User_Name & " said in " & Channel_Name & ": " & Text);
      if UserName = User_Name then return; end if; -- major lol ensued

      if Channel_Name /= "s44" and 0 /= Ada.Strings.Fixed.Index (Text, "#s44") then
         ATIO.Put_Line ("SAID: Someone mentioned #s44, responding");
         Send_Message_To_Server (Channel, "SAY " & Channel_Name & " Hi " & User_Name
                                   & ": If you are looking for joining #s44, type  /join #s44  (I am a bot)"
                                );
      end if;
   end Process_SAID;


   procedure Process_SAIDPRIVATE (User_Name : String; Text : String) is
   begin
      if Text = "!flood" then -- flood protect testing
         if User_Name = "ThinkIRC" then
            for I in 1 .. 8 loop
               Send_Message_To_Server (Channel, "SAYPRIVATE " & User_Name & " Flood!");
            end loop;
         end if;
      end if;
   end Process_SAIDPRIVATE;


   procedure Process_TASSERVER (
                                Protocol_Version : String;
                                Spring_Version   : String;
                                Helper_UDP_Port  : String;
                                Server_Mode      : Spring_Lobby_Server_Mode_Type
                               ) is
   begin
      null;
   end Process_TASSERVER;

   -----------------------------------------------------------------------------------------------
   -- ------------------------- SpringRTS Lobby Server Command Parsers ---------------------------
   -----------------------------------------------------------------------------------------------
   Parser_Failure : exception;


   function Expect_At (Where : String; What : Character; Index_Where : Positive) return Positive is
   begin
      if Where (Index_Where) /= What then
         raise Constraint_Error with "Mismatch at character " & Positive'Image (Index_Where - Where'First);
      end if;
      return Index_Where + 1;
   end Expect_At;


   procedure Raise_Exception_On_Leftovers (Where : in String;
                                           Index : in Positive
                                          ) is
   begin
      if Index /= (Where'Last + 1) then
         raise Parser_Failure with "leftover characters in message: '" & Where (Index .. Where'Last) & "'";
      end if;
   end;


   function Get_Token_Before_Delimiter (Where     : in String;
                                        Delimiter : in Character;
                                        Index     : in out Positive
                                       ) return String is
      Start_Index : constant Positive := Index;
      -- A word according to protocol ends with a space or if end of message is reached
   begin
      for Temp_Index in Start_Index .. Where'Last loop
         if Where (Temp_Index) = Delimiter then
            Index := Temp_Index + 1; -- Next thing after delimiter
            -- First case: delimiter found and is not right at the beginning
            if Temp_Index > Where'First then
               ATIO.Put ("Get_Token_Before_Delimiter: delimiter found. ");
               ATIO.Put_Line ("token: '" & Where (Start_Index .. (Temp_Index - 1)) & "'");
               return Where (Start_Index .. (Temp_Index - 1));
            else -- Second case: delimiter found, but is the first character.
               ATIO.Put_Line ("Get_Token_Before_Delimiter: delimiter found at start. ");
               return "";
            end if;
         end if;
      end loop;

      -- Third case: delimiter not found, return whole string after start index
      Index := Where'Last + 1;
      ATIO.Put ("Get_Token_Before_Delimiter: delimiter not found. ");
      ATIO.Put_Line ("token: '" & Where (Start_Index .. Where'Last) & "'");
      return Where (Start_Index .. Where'Last);
   end Get_Token_Before_Delimiter;



   -- ACCEPTED userName
   -- ^^^^^^^^^ already parsed by caller
   procedure Parse_ACCEPTED (Message : String) is
      Start_Index : constant Positive := Message'First + 8; -- Skip "ACCEPTED"
      Index : Positive := Expect_At (Message, ' ', Start_Index); -- First delimiter
      UserName : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
   begin
      if UserName'Length < 1 then
         raise Parser_Failure with "userName field is empty?";
      end if;
      ATIO.Put_Line ("Parse_ACCEPTED: username: " & UserName);

      Raise_Exception_On_Leftovers (Message, Index);

      Process_ACCEPTED (User_Name => UserName);
   exception
      when Error: Parser_Failure =>
         ATIO.Put_Line ("Malformed ACCEPTED: " & Ada.Exceptions.Exception_Message (Error));
         return;
   end Parse_ACCEPTED;


   -- BATTLEOPENED battleID type natType founder ip port maxPlayers passworded rank mapHash {engineName} {engineVersion} {map} {title} {gameName}
   -- ^^^^^^^^^^^^^ already parsed by caller
   procedure Parse_BATTLEOPENED (Message : String) is
      Start_Index : constant Positive := Message'First + 12; -- Skip "BATTLEOPENED"
      Index : Positive := Expect_At (Message, ' ', Start_Index); -- First delimiter
      Bo_BattleID          : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_Type_String       : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_NatType_String    : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_Founder           : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_Ip                : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_Port              : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_MaxPlayers        : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_Passworded_String : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_Rank              : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_MapHash_String    : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Bo_Map               : constant String := Get_Token_Before_Delimiter (Message, ASCII.HT, Index);
      Bo_Title             : constant String := Get_Token_Before_Delimiter (Message, ASCII.HT, Index);
      Bo_GameName          : constant String := Get_Token_Before_Delimiter (Message, ASCII.HT, Index);

      Bo_Type       : Spring_Lobby_Battle_Type;
      Bo_NatType    : Spring_Lobby_NAT_Traversal_Type;
      Bo_Passworded : Spring_Lobby_Passworded_Flag_Type;
      Bo_MapHash    : Spring_Lobby_Map_Hash_Type;
   begin
      if Index <= Message'Last then
         ATIO.Put_Line ("Parse_BATTLEOPENED: leftover tokens in message: '" & Message (Index .. Message'Last) & "'");
      end if;
      ATIO.Put_Line ("Got battleID:   '" & Bo_BattleID          & "'");
      ATIO.Put_Line ("Got type:       '" & Bo_Type_String       & "'");
      ATIO.Put_Line ("Got natType:    '" & Bo_NatType_String    & "'");
      ATIO.Put_Line ("Got founder:    '" & Bo_Founder           & "'");
      ATIO.Put_Line ("Got ip:         '" & Bo_Ip                & "'");
      ATIO.Put_Line ("Got port:       '" & Bo_Port              & "'");
      ATIO.Put_Line ("Got maxPlayers: '" & Bo_MaxPlayers        & "'");
      ATIO.Put_Line ("Got passworded: '" & Bo_Passworded_String & "'");
      ATIO.Put_Line ("Got rank:       '" & Bo_Rank              & "'");
      ATIO.Put_Line ("Got mapHash:    '" & Bo_MapHash_String    & "'");
      ATIO.Put_Line ("Got map:        '" & Bo_Map               & "'");
      ATIO.Put_Line ("Got title:      '" & Bo_Title             & "'");
      ATIO.Put_Line ("Got gameName:   '" & Bo_GameName          & "'");

      if    Bo_Type_String = "0" then
         Bo_Type := Normal_Battle;
      elsif Bo_Type_String = "1" then
         Bo_Type := Battle_Replay;
      else
         raise Parser_Failure with "Unknown battle type: '" & Bo_Type_String & "'";
      end if;

      if    Bo_NatType_String = "0" then
         Bo_NatType := None;
      elsif Bo_NatType_String = "1" then
         Bo_NatType := Hole_Punching;
      elsif Bo_NatType_String = "2" then
         Bo_NatType := Fixed_Source_Ports;
      else
         raise Parser_Failure with "Unknown NAT type: '" & Bo_NatType_String & "'";
      end if;

      if    Bo_Passworded_String = "0" then
         Bo_Passworded := False;
      elsif Bo_Passworded_String = "1" then
         Bo_Passworded := True;
      else
         raise Parser_Failure with "Unknown value for field passworded: '" & Bo_Passworded_String & "'";
      end if;

      declare
      begin
         Bo_MapHash := Integer'Value (Bo_MapHash_String);
      exception
         when CONSTRAINT_ERROR =>
            raise Parser_Failure with "Value for mapHash is out of range: '" & Bo_MapHash_String & "'";
      end;

      Raise_Exception_On_Leftovers (Message, Index);

      Process_BATTLEOPENED (
                            Battle_ID   => Bo_BattleID,
                            Battle_Type => Bo_Type,
                            NAT_Type    => Bo_NatType,
                            Founder     => Bo_Founder,
                            IP          => Bo_Ip,
                            Port        => Bo_Port,
                            Max_Players => Bo_MaxPlayers,
                            Passworded  => Bo_Passworded,
                            Rank        => Bo_Rank,
                            Map_Hash    => Bo_MapHash,
                            Map_Name    => Bo_Map,
                            Title       => Bo_Title,
                            Game_Name   => Bo_GameName
                           );
   exception
      when Error: Parser_Failure =>
         ATIO.Put_Line ("Malformed BATTLEOPENED: " & Ada.Exceptions.Exception_Message (Error));
         return;
   end Parse_BATTLEOPENED;


   -- DENIED {reason}
   -- ^^^^^^^ already parsed by caller
   procedure Parse_DENIED (Message : String) is
      Start_Index : constant Positive := Message'First + 6; -- Skip "DENIED" and a space
      Index : Positive := Expect_At (Message, ' ', Start_Index); -- First delimiter
      Reason : constant String := Get_Token_Before_Delimiter (Message, ASCII.HT, Index);
   begin
      if Reason'Length = 0 then
         raise Parser_Failure with "reason not provided?!";
      end if;
      ATIO.Put_Line ("Parse_DENIED: reason: '" & Reason & "'");

      Raise_Exception_On_Leftovers (Message, Index);

      Process_DENIED (Reason => Reason);
   exception
      when Error: Parser_Failure =>
         ATIO.Put_Line ("Malformed DENIED: " & Ada.Exceptions.Exception_Message (Error));
         return;
   end Parse_DENIED;


   -- LOGININFOEND
   -- ^^^^^^^^^^^^ Already parsed by caller
   procedure Parse_LOGININFOEND (Message : String) is
      Index : constant Positive := Message'First + 12; -- Skip "LOGININFOEND"
   begin
      Raise_Exception_On_Leftovers (Message, Index);

      Process_LOGININFOEND;
   end Parse_LOGININFOEND;


   -- SAID chanName userName {message}
   -- ^^^^^ already parsed by caller
   procedure Parse_SAID (Message : String) is
      Start_Index : constant Positive := Message'First + 4; -- Skip "SAID"
      Index : Positive := Expect_At (Message, ' ', Start_Index); -- First delimiter
      ChanName : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      UserName : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Text     : constant String := Get_Token_Before_Delimiter (Message, ASCII.HT, Index);
   begin
      if ChanName'Length = 0 then
         raise Parser_Failure with "chanName is empty?!";
      end if;
      ATIO.Put_Line ("Parse_SAID: chanName: " & ChanName & "'");

      if UserName'Length = 0 then
         raise Parser_Failure with "userName is empty?!";
      end if;
      ATIO.Put_Line ("Parse_SAID: userName: " & UserName & "'");

      if Text'Length = 0 then
         raise Parser_Failure with "text is empty?";
      end if;
      ATIO.Put_Line ("Parse_SAID: text: " & Text & "'");

      Raise_Exception_On_Leftovers (Message, Index);

      Process_SAID (
                    Channel_Name => ChanName,
                    User_Name    => UserName,
                    Text         => Text
                   );
   exception
      when Error: Parser_Failure =>
         ATIO.Put_Line ("Malformed SAID: " & Ada.Exceptions.Exception_Message (Error));
         return;
   end Parse_SAID;


   -- SAIDPRIVATE userName {message}
   -- ^^^^^^^^^^^^ already parsed by caller
   procedure Parse_SAIDPRIVATE (Message : String) is
      Start_Index : constant Positive := Message'First + 11; -- Skip "SAIDPRIVATE"
      Index : Positive := Expect_At (Message, ' ', Start_Index); -- First delimiter
      UserName : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      Text     : constant String := Get_Token_Before_Delimiter (Message, ASCII.HT, Index);
   begin
      if UserName'Length = 0 then
         raise Parser_Failure with "userName is empty?!";
      end if;
      ATIO.Put_Line ("Parse_SAIDPRIVATE: userName: '" & UserName & "'");

      if Text'Length = 0 then
         raise Parser_Failure with "text is empty?!";
      end if;
      ATIO.Put_Line ("Parse_SAIDPRIVATE: text: '" & Text & "'");

      Raise_Exception_On_Leftovers (Message, Index);

      Process_SAIDPRIVATE (
                           User_Name => UserName,
                           Text      => Text
                          );
   exception
      when Error: Parser_Failure =>
         ATIO.Put_Line ("Malformed SAIDPRIVATE: " & Ada.Exceptions.Exception_Message (Error));
         return;
   end Parse_SAIDPRIVATE;


   -- TASSERVER protocolVersion springVersion udpPort serverMode
   -- ^^^^^^^^^^ already parsed by caller
   procedure Parse_TASSERVER (Message : String) is
      Start_Index : constant Positive := Message'First + 9; -- Skip "TASSERVER"
      Index : Positive := Expect_At (Message, ' ', Start_Index); -- First delimiter
      ProtocolVersion   : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      SpringVersion     : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      UdpPort           : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);
      ServerMode_String : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);

      ServerMode : Spring_Lobby_Server_Mode_Type;
   begin
      if    ServerMode_String = "0" then
         ServerMode := Normal_Mode;
      elsif ServerMode_String = "1" then
         ServerMode := LAN_Mode;
      else
         raise Parser_Failure with "unsupported value for field serverMode: '" & ServerMode_String & "'";
      end if;

      Raise_Exception_On_Leftovers (Message, Index);

      Process_TASSERVER (
                         Protocol_Version => ProtocolVersion,
                         Spring_Version   => SpringVersion,
                         Helper_UDP_Port  => UdpPort,
                         Server_Mode      => ServerMode
                        );
   end Parse_TASSERVER;
   -----------------------------------------------------------------------------------------------
   -------------------- Dispatcher for SpringRTS Lobby Server Command Parsers --------------------
   -----------------------------------------------------------------------------------------------
   procedure Process_Message (Message: String) is
      package Map_Command_To_ID is new Ada.Containers.Indefinite_Ordered_Maps
        (Key_Type => String, Element_Type => Spring_Lobby_Command_ID_Type);

      Map : Map_Command_To_ID.Map;

      Index : Positive := Message'First;
      Command_String : constant String := Get_Token_Before_Delimiter (Message, ' ', Index);


      procedure Insert_To (Map        : in out Map_Command_To_ID.Map;
                           Command_ID : Spring_Lobby_Command_ID_Type
                          ) is
      begin
         Map_Command_To_ID.Insert (Map, To_String (Command_ID), Command_ID);
      end Insert_To;
   begin
      Insert_To (Map, ACCEPTED);
      Insert_To (Map, BATTLEOPENED);
      Insert_To (Map, DENIED);
      Insert_To (Map, LOGININFOEND);
      Insert_To (Map, SAID);
      Insert_To (Map, SAIDPRIVATE);
      Insert_To (Map, TASSERVER);

      ATIO.Put_Line ("server => " & Message);
      declare
         Cursor : constant Map_Command_To_ID.Cursor := Map_Command_To_ID.Find (Map, Command_String);
         use type Map_Command_To_ID.Cursor;
      begin
         if Cursor = Map_Command_To_ID.No_Element then
            ATIO.Put_Line ("Warning: no parser available for lobby command: '"
              & Command_String & "'");
            return; -- short circuit to keep the indents lower
         end if;

         case Map_Command_To_ID.Element (Cursor) is
         when ACCEPTED           => Parse_ACCEPTED (Message);
         when BATTLEOPENED       => Parse_BATTLEOPENED (Message);
         when DENIED             => Parse_DENIED (Message);
         when LOGININFOEND       => Parse_LOGININFOEND (Message);
         when SAID               => Parse_SAID (Message);
         when SAIDPRIVATE        => Parse_SAIDPRIVATE (Message);
         when TASSERVER          => Parse_TASSERVER (Message);
         end case;
      end;
   end Process_Message;

begin
   --   ATIO.put_line ("MD5: " & ct.to_hex (md5string)); -- broken atm, should convert to hex
   ATIO.Put_Line ("MD5+base64: " & Password);

   ATIO.Put_Line ("Connecting to lobby...");

   GS.Create_Socket (Client);
   Address.Addr := GS.Addresses (GS.Get_Host_By_Name ("lobby.springrts.com"), 1); -- get first address (official?)
   Address.Port := 8200;

   GS.Connect_Socket (Client, Address);
   Channel := GS.Stream (Client);

   Send_Message_To_Server (Channel, "LOGIN " & Username & " " & Password & " 0 * AdaLobby/Bot 0.1");
   -- main loop:
   loop
      select
         delay until Next_PING_Time;
         ATIO.Put_Line ("  Timeout");
         Send_Message_To_Server (Channel, "PING");
         Next_PING_Time := Clock + PING_Period;
      then abort
         Line := Get_Line (Channel);
         Process_Message (ASU.To_String (Line));
      end select;
   end loop;
exception
   when Ada.IO_Exceptions.End_Error =>
      ATIO.Put_Line ("Socket closed, exiting.");
end Ada_Lobby_Bot;