--
--  Author: Brent Seidel
--  Date: 31-Jul-2024
--
--  This file is part of SimCPU.
--  SimCPU is free software: you can redistribute it and/or modify it
--  under the terms of the GNU General Public License as published by the
--  Free Software Foundation, either version 3 of the License, or (at your
--  option) any later version.
--
--  SimCPU is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
--  Public License for more details.
--
--  You should have received a copy of the GNU General Public License along
--  with SimCPU. If not, see <https://www.gnu.org/licenses/>.--
--
with Ada.Streams;
use type Ada.Streams.Stream_Element_Offset;
use type Ada.Streams.Stream_Element;
with Ada.Text_IO;
with Ada.Exceptions;
package body BBS.Sim_CPU.serial.telnet is
   --  ----------------------------------------------------------------------
   --  Telnet device actions
   --
   --  Set device port and do the network initialiation.  This must be
   --  done only once before using the device.
   --
   procedure init(self : in out tel_tty; ptr : telnet_access; port : GNAT.Sockets.Port_Type) is
   begin
     self.T.start(ptr, port, self.host);
   end;
   --
   --  Set which exception to use
   --
   procedure setException(self : in out tel_tty; except : long) is
   begin
      self.int_code := except;
   end;
   --
   --  Write to a port address.
   --  If nothing is connected, the characters are just dropped.
   --
   overriding
   procedure write(self : in out tel_tty; addr : addr_bus; data : data_bus) is
   begin
      if (addr = (self.base + 1)) and self.connected then
         self.T.write(Character'Val(Integer(data and 16#FF#)));
      elsif addr = self.base then
         self.int_e := (data and 4) /= 0;
         if (data and 8) /= 0 then  --  Reset command.
            self.ready := False;
            self.char := Character'Val(0);
         end if;
      end if;
   exception
     when e : others =>
       Ada.Text_IO.Put_Line("Exception occured while trying to write to console.");
       Ada.Text_IO.Put_Line("  Name: " & Ada.Exceptions.Exception_Name(e));
       Ada.Text_IO.Put_Line("  Msg:  " & Ada.Exceptions.Exception_Message(e));
   end;
   --
   --  Read from a port address
   --
   overriding
   function read(self : in out tel_tty; addr : addr_bus) return data_bus is
   begin
      if addr = (self.base + 1) then
         self.ready := False;
--         Ada.Text_IO.Put_Line("TTY: Returning character code " & toHex(byte(data_bus(Character'Pos(self.char)) and 16#FF#)));
         return data_bus(Character'Pos(self.char));
      elsif addr = self.base then
         return 0 +
               (if self.ready then 1 else 0) +
               (if self.connected then 2 else 0) +
               (if self.int_e then 4 else 0);
      end if;
      return 0;
   end;
   --
   --  Get the base address
   --
   overriding
   function getBase(self : in out tel_tty) return addr_bus is
   begin
      return self.base;
   end;
   --
   --  Set the base address
   --
   overriding
   procedure setBase(self : in out tel_tty; base : addr_bus) is
   begin
      self.base := base;
   end;
   --
   --  Set the owner (used mainly for DMA and interrupts)
   --
   overriding
   procedure setOwner(self : in out tel_tty; owner : sim_access) is
   begin
      self.host := owner;
   end;
   --
   --  Close the network connection and halt the tasks.
   --
   procedure shutdown(self : in out tel_tty) is
   begin
      --
      --  Abort is used here as this is only called when the program is
      --  terminating and if no telnet connection has been made, the
      --  task will be blocked waiting for a connection.
      --
      abort self.T;
--     self.T.end_task;
   end;
   --
   --  Task type for telnet type server
   --
   task body telnet_server is
      data      : telnet_access;
      host      : BBS.Sim_CPU.sim_access;
      exit_flag : Boolean := False;
      sock_ser  : GNAT.Sockets.Socket_Type;  --  Server Socket
      sock_com  : GNAT.Sockets.Socket_Type;  --  Communication Socket
      rx_task   : telnet_rx;
      local     : GNAT.Sockets.Sock_Addr_Type;
      s         : GNAT.Sockets.Stream_Access;
   begin
      accept start(self : telnet_access; port : GNAT.Sockets.Port_Type; owner : BBS.Sim_CPU.sim_access) do
         data := self;
         local.Addr := GNAT.Sockets.Any_Inet_Addr;
         local.Port := port;
         host := owner;
         GNAT.Sockets.Create_Socket(sock_ser, GNAT.Sockets.Family_Inet,
                                 GNAT.Sockets.Socket_Stream);
         GNAT.Sockets.Set_Socket_Option(sock_ser, GNAT.Sockets.Socket_Level,
                                       (GNAT.Sockets.Reuse_Address, True));
         GNAT.Sockets.Bind_Socket(sock_ser, local);
         GNAT.Sockets.Listen_Socket(sock_ser);
      end start;
      loop
         select
            accept write(char : Character) do
               String'write(s, "" & char);
            end write;
         or
            accept end_task do
               exit_flag := True;
            end end_task;
         or
            delay 0.0;
         end select;
         exit when exit_flag;
         if data.all.disconnecting then
            --
            --  This produces a warning that sock_com may be used before
            --  it's set.  This should not be a problem in normal operation
            --  since connected has to be set True before disconnecting
            --  can be set false.
            --
            pragma Warnings (Off, "Connections happens before disconnecting");
            GNAT.Sockets.Close_Socket(sock_com);
            pragma Warnings (On, "Connections happens before disconnecting");
            data.all.disconnecting := False;
         end if;
         if not data.all.connected then
            --
            --  This call blocks until a connection request comes in.
            --
            GNAT.Sockets.Accept_Socket(sock_ser, sock_com, local);
            s := GNAT.Sockets.Stream(sock_com);
            data.all.connected := True;
            String'write(s, "Connected to simulated CPU " & host.name & CRLF);
            rx_task.start(data, sock_com, host);
         end if;
      end loop;
      rx_task.end_task;
      GNAT.Sockets.Close_Socket(sock_ser);
      GNAT.Sockets.Close_Socket(sock_com);
   end telnet_server;
   --
   --  Task body for telnet receiver task.  This is intended to only be
   --  used by the main telnet task for reciving characters from the
   --  network connection.
   --
   task body telnet_rx is
      exit_flag : Boolean := False;
      data      : telnet_access;
      host      : BBS.Sim_CPU.sim_access;
      sock_com  : GNAT.Sockets.Socket_Type;
      last      : Ada.Streams.Stream_Element_Offset;
      elem      : Ada.Streams.Stream_Element_Array(1 .. 1);
      cmd_state : byte := 0;
   begin
      accept start(self : telnet_access; sock : GNAT.Sockets.Socket_Type; owner : BBS.Sim_CPU.sim_access) do
         data := self;
         sock_com := sock;
         host := owner;
      end start;
      loop
         select
            accept end_task do
               exit_flag := True;
            end end_task;
            or
            accept start(self : telnet_access; sock : GNAT.Sockets.Socket_Type; owner : BBS.Sim_CPU.sim_access) do
               data := self;
               sock_com := sock;
               host := owner;
            end start;
            or
               delay 0.0;
         end select;
         exit when exit_flag;
         if data.all.connected then
            GNAT.Sockets.Receive_Socket(sock_com, elem, last);
--            Ada.Text_IO.Put_Line("TTY: Character received: " & toHex(byte(elem(1))));
            if last = 0 then
               data.all.connected := False;
               data.all.disconnecting := True;
--               Ada.Text_IO.Put_Line("TTY: Receiver disconnecting");
            --
            --  If the client has not read the last character, drop the current
            --  current one.  Buffering could be added at some point, but this
            --  seems to be consistent with the way that CP/M works.
            --
            else
            --
            --  The telnet protocol uses in-band signalling with FF
            --  indicating the start of option signalling.  The sequences
            --  I've seen are:
            --  FF FD 01  (IAC DO echo?)
            --  FF FD 03  (IAC DO supress go ahead?)
            --  There are more defined somewhere.  We just want to ignore
            --  them for now.  If a character FF needs to be sent, it is
            --  sent as FF FF.  It may be that at some point, software
            --  running on the simulator may wish to see these.  At that
            --  point, it could be made into an option.
            --
               if (elem(1) = 16#FF#) and ((cmd_state = 0) or (cmd_state = 3)) then     --  Start of CMD
                  cmd_state := 1;
               elsif (elem(1) = 16#FF#) and (cmd_state = 1) then  --  Escaped FF
                  cmd_state := 0;
               elsif cmd_state = 1 then  --  Ignore next character
                  cmd_state := 2;
               elsif cmd_state = 2 then  --  Ignore next character
                  cmd_state := 3;
               elsif cmd_state = 3 then  --  Reset
                  cmd_state := 0;
               end if;
               if (not data.all.ready) and (cmd_state = 0) then
--                  Ada.Text_IO.Put_Line("TTY: Character stored: " & toHex(byte(elem(1))));
                  data.all.char := Character'Val(elem(1));
                  data.all.ready := True;
               end if;
            end if;
            if data.all.int_e and data.all.ready then
--               Ada.Text_IO.Put_Line("TTY: Sending interrupt " & toHex(data.all.int_code));
               host.interrupt(data.all.int_code);
            end if;
         end if;
      end loop;
   end telnet_rx;
end;
