Programmation Socket en Ada

chatd.adb

with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Sockets; use GNAT.Sockets;
with GNAT.Sockets.Friendly; use GNAT.Sockets.Friendly;

procedure Chatd is
  type idcli is range 1..100;
  type user(Connected : Boolean := false) is record
    case Connected is
        when False => null;
        when True =>
            login : access String;
            socket : Socket_Type;
    end case;
  end record;
  Client : array(idcli) of user := (others => (Connected => false));
  socket : Socket_Type;
  addr : Sock_Addr_Type;
  selector : Selector_Type;
  status : Selector_Status;
  RSet, WSet : Socket_Set_Type;
begin
  Create_Socket(socket);
  addr.Addr := Any_Inet_Addr;
  addr.Port := 7777;
  Bind_Socket(socket, addr);
  Put_Line("Listening on port" & Port_Type'Image(addr.Port));
  Listen_Socket(socket);
  Create_Selector(selector);
  Empty(WSet);
  loop
    Empty(RSet);
    Set(RSet, socket);
    for I in idcli loop
      if Client(I).connected then
          Set(RSet, Client(I).socket);
      end if;
    end loop;
    Check_Selector(selector, RSet, WSet, status);
    case status is
        when Completed =>
            if Is_Set(Rset, socket) then
              declare
                pos : idcli := 1;
                clisock : Socket_Type;
                addr : Sock_Addr_Type;
              begin
                while Client(pos).connected loop 
                    pos := pos + 1;
                end loop;
                Put("Connection" & idcli'Image(pos) & ". "); Flush;
                Accept_Socket(socket, clisock, addr);
                declare
                 login : String := Recv(clisock);
                begin
                  if login(login'last) /= ASCII.LF then
                      Put_Line(current_error, "Bad login :-(");
                  else
                      Put_Line("Hello " & login(1..login'last-1));
                      Client(pos) := (true, new String'(login(1..login'last-1)), clisock);
                  end if;
                end;
              end;
            end if;
            for I in idcli loop
                if Client(I).connected and then Is_Set(Rset, Client(I).socket) then
                    Put("Client" & idcli'Image(I) & " wants to talk. "); Flush;
                    declare
                        msg : String := Recv(Client(I).socket);
                    begin
                      if msg'length = 0 then
                        Put_Line("Goodbye" & idcli'Image(I) & "!");
                        for J in idcli loop
                            if I /=J and then Client(J).connected then
                                Put("Sending to" & idcli'Image(J) & ". "); Flush;
                                Send(Client(J).socket, "** " & Client(I).login.all & " leaved." & ASCII.LF);
                                Put_Line("OK");
                            end if;
                        end loop;
                        Client(I) := (Connected => False);
                      else
                        Put_Line("Received" & Integer'Image(msg'length) & " bytes.");
                        for J in idcli loop
                            if I /=J and then Client(J).connected then
                                Put("Sending to" & idcli'Image(J) & ". "); Flush;
                                Send(Client(J).socket, Client(I).login.all & ": " & msg);
                                Put_Line("OK");
                            end if;
                        end loop;
                      end if;
                    end;
                end if;
            end loop;
        when others =>
            Put_Line("Selector " & Selector_Status'Image(status));
    end case;
  end loop;  
end Chatd;

echo.adb

with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Sockets.Friendly; use GNAT.Sockets.Friendly;
use GNAT.Sockets;
with Ada.Command_Line; use Ada.Command_Line;

procedure echo is
  Socket : Socket_Type;
  Addr : Sock_Addr_Type;

begin
  if Argument_Count /= 3 then
    Put_Line(Current_Error, "Usage: " & Command_Name & " host port message");
    Set_Exit_Status(1);
    return;
  end if;
  -- Crée une socket UDP
  Create_Socket(Socket, Family_Inet, Socket_Datagram);
  -- Envoie le message 
  Addr.Addr := Addresses(Get_Host_By_Name(Argument(1)), 1);
  Addr.Port := Port_Type'Value(Argument(2));
  Send(Socket, Addr, Argument(3));
  declare
      -- Attend un message entrant
      Message : String := Recv(Socket, Addr);
    begin
      Put(Image(Addr) & " said ");
      Put_Clean(Message);
      New_Line;
    end;
end echo;

echod.adb

with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Sockets.Friendly; use GNAT.Sockets.Friendly;
use GNAT.Sockets;

procedure echod is
  Socket : Socket_Type;
  Addr : Sock_Addr_Type;

begin
  -- Crée une socket UDP
  Create_Socket(Socket, Family_Inet, Socket_Datagram);
  -- Associe la socket à un port local
  Bind_Socket(Socket, (Family_Inet, Any_Inet_Addr, 7777));
  Put_Line("Listening on port 7777");
  loop
    declare
      -- Attend un message entrant
      Message : String := Recv(Socket, Addr);
    begin
      Put(Image(Addr) & " said ");
      Put_Clean(Message);
      New_Line;
      -- Renvoie le message !
      Send(Socket, Addr, Message);
    end;
  end loop;
end echod;

gethttp.adb

with Ada.Streams; use Ada.Streams;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Text_IO.Text_Streams; use Ada.Text_IO.Text_Streams; 
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Sockets; use GNAT.Sockets;

procedure GetHTTP is
  socket : Socket_Type;
  addr : Sock_Addr_Type;
  channel_sock : GNAT.Sockets.Stream_Access;
  channel_out : Text_Streams.Stream_Access;
  buffer : Stream_Element_Array(1 .. 1024);
  last : Stream_Element_Count;
  eol : constant String := (1 => ASCII.CR, 2 => ASCII.LF);
begin
  if Argument_Count /= 2 then
    Put_Line(Current_Error, "Usage: " & Command_Name & " host port");
    Set_Exit_Status(1);
    return;
  end if;
  Create_Socket(socket);
  addr.Addr := Addresses(Get_Host_By_Name(Argument(1)), 1);
  addr.Port := Port_Type'Value(Argument(2));
  Connect_Socket(socket, addr);
  channel_sock := Stream(socket);
  channel_out := Stream(Current_Output);
  String'Write(channel_sock, "GET / HTTP/1.0" & eol & "Host: " & Argument(1) & eol & eol);
  loop
    Read(channel_sock.all, buffer, last);
    exit when last = 0;
    Write(channel_out.all, buffer(1..last));
  end loop;
end GetHTTP;

gnat-sockets-friendly.adb

with Ada.Streams; use Ada.Streams;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Mojo; use Mojo;
with Ada.Text_IO; use Ada.Text_IO;

package body GNAT.Sockets.Friendly is

  function Send(Socket : Socket_Type; Addr : Sock_Addr_Type; Message : String) return Integer is
    Last : Stream_Element_Offset;
  begin
    Send_Socket(Socket,To_Stream_Element_Array(Message),Last,Addr);
    return Integer(Last);
  end Send;

  procedure Send(Socket : Socket_Type; Addr : Sock_Addr_Type; Message : String) is
    Last : Integer;
  begin
    Last := Send(Socket, Addr, Message);
  end Send;

  procedure Send(Socket : Socket_Type; Message : String) is
    Last : Stream_Element_Offset;
  begin
    Send_Socket(Socket, To_Stream_Element_Array(Message), Last);
  end Send;

  function Recv(Socket : Socket_Type; Addr : out Sock_Addr_Type) return String is
    Buffer : Stream_Element_Array(1..1024);
    Last : Stream_Element_Offset;
  begin
    Receive_Socket(Socket,Buffer,Last,Addr);
    return To_String(Buffer(Buffer'First..Last));
  end Recv;

  function Recv(Socket : Socket_Type) return String is
    Buffer : Stream_Element_Array(1..1024);
    Last : Stream_Element_Offset;
  begin
    Receive_Socket(Socket,Buffer,Last);
    return To_String(Buffer(Buffer'First..Last));
  end Recv;

  procedure Put_Clean(Data : String) is
    hex : String(1..16) := "0123456789abcdef";
  begin
    Put("'");
    for I in Data'Range loop
      if Data(I) = '\' then
          Put("\\");
      elsif Is_Graphic(Data(I)) then
          Put(Data(I));
      elsif Data(I) = LF then
          Put("\n");
      else
          Put("\x");
          declare
            Cur : Integer := Character'Pos(Data(I));
          begin
            Put(hex(1+Cur/16));
            Put(hex(1+Cur mod 16));
          end;
      end if;
    end loop;
    Put("'");
  end Put_Clean;

end GNAT.Sockets.Friendly;

gnat-sockets-friendly.ads

with Ada.Streams; use Ada.Streams;

package GNAT.Sockets.Friendly is

  function Send(Socket : Socket_Type; Addr : Sock_Addr_Type; Message : String) return Integer;
  procedure Send(Socket : Socket_Type; Addr : Sock_Addr_Type; Message : String);
  procedure Send(Socket : Socket_Type; Message : String);
  function Recv(Socket : Socket_Type; Addr : out Sock_Addr_Type) return String;
  function Recv(Socket : Socket_Type) return String;
  procedure Put_Clean(Data : String);

end GNAT.Sockets.Friendly;

mojo.adb

with Ada.Streams; use Ada.Streams;
with Ada.Unchecked_Conversion;

package body Mojo is
  function To_Stream_Element_Array(Data : String) return Stream_Element_Array is
    subtype str is String(Data'Range);
    subtype arr is Stream_Element_Array(Stream_Element_Offset(Data'First) .. Stream_Element_Offset(Data'Last));
    function magic is new Ada.Unchecked_Conversion(str,arr);
  begin
    return magic(Data);
  end To_Stream_Element_Array;

  function To_String(Data : Stream_Element_Array) return String is
    subtype str is String(Integer(Data'First) .. Integer(Data'Last));
    subtype arr is Stream_Element_Array(Data'Range);
    function magic is new Ada.Unchecked_Conversion(arr,str);
  begin
    return magic(Data);
  end To_String;
end Mojo;

mojo.ads

with Ada.Streams; use Ada.Streams;

package Mojo is
  function To_Stream_Element_Array(Data : String) return Stream_Element_Array;
  function To_String(Data : Stream_Element_Array) return String;
end Mojo;

coneta a computadoras ?