⟦693fefb72⟧

TextFile

WITH Byte_Defs;
WITH Socket_System_Interface;
WITH System;
WITH System_Interface;
WITH Transport_Defs;
WITH Unchecked_Conversion;
WITH Unix_Base_Types;
WITH Text_Io;

USE Text_Io;
PACKAGE BODY Transport IS

   Prototype_Error : EXCEPTION;


   Unix_Error : CONSTANT Unix_Base_Types.Int := -1;


   TYPE Process_Kind IS (Nul, Server, Client);


   TYPE Socket_Status_Kind IS (Open, Connected, Not_Connected, Closed);
   -- For Servers:
   --   Open implies that the passive socket is Open, Bound and Listening.
   --   Connected means that the _accept call has completed and a
   --      connection with a remote (active) socket has been established.
   -- For Clients:
   --   Open implies that the local _socket call has completed successfully.
   --   Connected implies that the _connect call has completed successfully
   --      and that an active connection to the specified remote socket
   --      has been established.
   -- For both Servers and Clients:
   --   Not_Connected implies that the Connection is still open after a
   --      transmit or receive failure.  The socket should be Closed and then
   --      reopened.  You CANNOT simply reconnect a socket that is
   --      Not_Connected.
   --


   -- Private type completion
   TYPE Connection_Info IS
      RECORD
         Kind                    : Process_Kind        := Nul;
         Socket_Status           : Socket_Status_Kind  := Closed;
         Local_Socket_Descriptor : Unix_Base_Types.Int := Unix_Error;
         Tcp_Socket_Descriptor   : Unix_Base_Types.Int := Unix_Error;
         Local_Sockaddr_In       : Socket_System_Interface.Sockaddr_In;
         Remote_Sockaddr_In      : Socket_System_Interface.Sockaddr_In;
         Next                    : Connection_Id       := NULL;
      END RECORD;


   Free_List : Connection_Id := NULL;


   FUNCTION ">" (L, R : Byte_Defs.Byte) RETURN Boolean RENAMES Byte_Defs.">";

   FUNCTION "-" (L, R : Byte_Defs.Byte) RETURN Byte_Defs.Byte
       RENAMES Byte_Defs."-";


   FUNCTION "=" (Left  : Transport_Defs.Status_Code;
                 Right : Transport_Defs.Status_Code)  
                RETURN Boolean RENAMES Transport_Defs."=";


   FUNCTION "=" (Left  : Transport_Defs.Socket_Id;
                 Right : Transport_Defs.Socket_Id)  
                RETURN Boolean RENAMES Transport_Defs."=";


   FUNCTION To_Sockaddr_In IS  
      NEW Unchecked_Conversion (Source => Socket_System_Interface.Sockaddr,
                                Target => Socket_System_Interface.Sockaddr_In);


   FUNCTION To_Sockaddr IS  
      NEW Unchecked_Conversion (Source => Socket_System_Interface.Sockaddr_In,
                                Target => Socket_System_Interface.Sockaddr);


   FUNCTION To_Sockaddr_In_Ptr IS  
      NEW Unchecked_Conversion
             (Source => System.Address,
              Target => Socket_System_Interface.Sockaddr_In_Ptr);


   FUNCTION To_Sockaddr_Ptr IS  
      NEW Unchecked_Conversion
             (Source => System.Address,
              Target => Socket_System_Interface.Sockaddr_Ptr);


   FUNCTION To_Int_Ptr IS  
      NEW Unchecked_Conversion (Source => System.Address,
                                Target => Socket_System_Interface.Int_Ptr);


   FUNCTION Get RETURN Connection_Id IS SEPARATE;

   PROCEDURE Free (Connection : Connection_Id) IS SEPARATE;

   PROCEDURE Start_System_Call IS SEPARATE;

   FUNCTION Finish_System_Call RETURN Unix_Base_Types.Int IS SEPARATE;

   FUNCTION Convert_Errno (Errno : Unix_Base_Types.Int)
                          RETURN Transport_Defs.Status_Code IS SEPARATE;


   FUNCTION Byte_String_To_Integer (Bs : Byte_Defs.Byte_String)
                                   RETURN Unix_Base_Types.Int IS SEPARATE;


   PROCEDURE Open_Server (Connection   : OUT Transport.Connection_Id;
                          Status       : OUT Transport_Defs.Status_Code;
                          Network      : IN  Transport_Defs.Network_Name;
                          Local_Socket : IN  Transport_Defs.
                                               Socket_Id) IS SEPARATE;


   PROCEDURE Open_Client (Connection : OUT Transport.Connection_Id;
                          Status     : OUT Transport_Defs.Status_Code;
                          Network    : IN  Transport_Defs.
                                             Network_Name) IS SEPARATE;


   --
   -- Spec level routines
   --
   PROCEDURE Open (Connection   : OUT Transport.Connection_Id;
                   Status       : OUT Transport_Defs.Status_Code;
                   Network      :     Transport_Defs.Network_Name;
                   Local_Socket :     Transport_Defs.Socket_Id :=
                      Transport_Defs.Null_Socket_Id) IS

      -- IT IS ASSUMED THAT Server TASK WILL BE STARTED ON A KNOWN LOCAL
      -- SOCKET.  Client TASKS WON'T CARE WHAT LOCAL_SOCKET THEY START ON
      -- AND WILL CALL OPEN WITH Local_Socket =
      -- Transport_Defs.Null_Socket_Id.
      --
      Is_Server : CONSTANT Boolean :=
         Local_Socket /= Transport_Defs.Null_Socket_Id;

   BEGIN
      IF Is_Server THEN
         Open_Server (Connection   => Connection,
                      Status       => Status,
                      Network      => Network,
                      Local_Socket => Local_Socket);
      ELSE
         Open_Client (Connection => Connection,
                      Status     => Status,
                      Network    => Network);
      END IF;
   END Open;


   PROCEDURE Close (Connection : Transport.Connection_Id) IS SEPARATE;
   PROCEDURE Connect (Connection    :     Transport.Connection_Id;
                      Status        : OUT Transport_Defs.Status_Code;
                      Remote_Host   :     Transport_Defs.Host_Id;
                      Remote_Socket :     Transport_Defs.Socket_Id;
                      Max_Wait      :     Duration := Duration'Last) IS
      --
      Laddr_In : Socket_System_Interface.Sockaddr_In :=
         (Sin_Family => Socket_System_Interface.Af_Inet,
          Sin_Port => Unix_Base_Types.Ushort
                         (Byte_String_To_Integer
                             (Byte_Defs.Byte_String  
                                 (Transport_Defs.Normalize (Remote_Socket)))),  
          Sin_Addr => Unix_Base_Types.U_Long
                         (Byte_String_To_Integer
                             (Byte_Defs.Byte_String
                                 (Transport_Defs.Normalize (Remote_Host)))),
          Sin_Zero => (OTHERS => Ascii.Nul));

      Laddrlen : Unix_Base_Types.Int := Laddr_In'Size / System.Storage_Unit;

      Laddr_In_Ptr : Socket_System_Interface.Sockaddr_In_Ptr :=
         To_Sockaddr_In_Ptr (Laddr_In'Address);


      Temp_Connection    : Connection_Id := Connection;
      System_Call_Result : Unix_Base_Types.Int;
      Errno              : Unix_Base_Types.Int;


   BEGIN
      IF Temp_Connection = Null_Connection_Id OR ELSE
         Temp_Connection.Socket_Status /= Open THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      ELSIF Temp_Connection.Socket_Status = Not_Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      Status := Transport_Defs.Ok;

      Start_System_Call;

      System_Call_Result := Socket_System_Interface.Connect
                               (S => Temp_Connection.Local_Socket_Descriptor,
                                Addr => Laddr_In_Ptr,
                                Addrlen => Laddrlen);

      Errno := Finish_System_Call;

      IF (System_Call_Result < 0) THEN
         Status := Convert_Errno (Errno => Errno);
         RETURN;
      END IF;

      Temp_Connection.Socket_Status     := Connected;
      Temp_Connection.Local_Sockaddr_In := Laddr_In;


   END Connect;


   --
   -- Form a passive connection.  This connection must be formed by a
   -- Server.  It waits for a remote connection from an active Client.
   --
   PROCEDURE Connect (Connection :     Transport.Connection_Id;
                      Status     : OUT Transport_Defs.Status_Code;
                      Max_Wait   :     Duration := Duration'Last) IS

      Temp_Connection : Connection_Id := Connection;

      Laddr : Socket_System_Interface.Sockaddr;

      Laddr_Ptr : Socket_System_Interface.Sockaddr_Ptr :=
         To_Sockaddr_Ptr (Laddr'Address);

      Laddrlen : Unix_Base_Types.Int :=
         Temp_Connection.Local_Sockaddr_In'Size / System.Storage_Unit;

      Laddrlen_Ptr : Socket_System_Interface.Int_Ptr :=
         To_Int_Ptr (Laddrlen'Address);

      Tcp_Connection : Unix_Base_Types.Int;
      Errno          : Unix_Base_Types.Int;

   BEGIN

      IF Temp_Connection = Null_Connection_Id OR ELSE
         Temp_Connection.Socket_Status = Closed THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      ELSIF Temp_Connection.Socket_Status = Not_Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      Accept_Loop:
         LOOP
            Status := Transport_Defs.Ok;

            Start_System_Call;

            Tcp_Connection :=  
               Socket_System_Interface.Saccept
                  (S       => Temp_Connection.Local_Socket_Descriptor,
                   Addr    => Laddr_Ptr,
                   Addrlen => Laddrlen_Ptr);

            Errno := Finish_System_Call;

            IF (Tcp_Connection < 0) THEN
               Status := Convert_Errno (Errno => Errno);
               IF Errno /= System_Interface.Error.Eintr THEN
                  RETURN;  
               END IF;  
            ELSE
               EXIT Accept_Loop;
            END IF;
         END LOOP Accept_Loop;

      Temp_Connection.Socket_Status         := Connected;
      Temp_Connection.Tcp_Socket_Descriptor := Tcp_Connection;
      Temp_Connection.Remote_Sockaddr_In    := To_Sockaddr_In (Laddr_Ptr.ALL);

   END Connect;



   PROCEDURE Disconnect (Connection : Transport.Connection_Id) IS

      Temp_Connect       : Transport.Connection_Id := Connection;
      System_Call_Result : Unix_Base_Types.Int;
      File_Descriptor    : Unix_Base_Types.Int;

   BEGIN
      IF Temp_Connect = Null_Connection_Id OR ELSE
         Temp_Connect.Socket_Status /= Connected THEN
         RETURN;
      END IF;

      IF Temp_Connect.Kind = Server THEN  
         File_Descriptor := Temp_Connect.Tcp_Socket_Descriptor;
      ELSE
         File_Descriptor := Temp_Connect.Local_Socket_Descriptor;
      END IF;

      IF Temp_Connect.Kind = Client THEN
         System_Call_Result :=  
            Socket_System_Interface.Shutdown (S => File_Descriptor, How => 2);
      END IF;

      System_Call_Result :=  
         System_Interface.File_Io.Close (Fildes => File_Descriptor);

      IF System_Call_Result < 0 THEN
         RAISE Program_Error;
      ELSE

         IF Temp_Connect.Kind = Server THEN  
            Temp_Connect.Tcp_Socket_Descriptor := Unix_Error;
            Temp_Connect.Socket_Status         := Open;
         ELSE
            Temp_Connect.Local_Socket_Descriptor := Unix_Error;
            Temp_Connect.Socket_Status           := Closed;
         END IF;

      END IF;
   END Disconnect;


   FUNCTION Is_Open (Connection : Transport.Connection_Id) RETURN Boolean IS
   BEGIN
      IF Connection = Null_Connection_Id THEN
         RETURN False;
      END IF;


      CASE Connection.Kind IS
         WHEN Server | Client =>
            RETURN (Connection.Socket_Status = Open) OR
                      (Connection.Socket_Status = Not_Connected);
         WHEN OTHERS =>
            RETURN False;
      END CASE;
   END Is_Open;


   FUNCTION Is_Connected
               (Connection : Transport.Connection_Id) RETURN Boolean IS
   BEGIN
      IF Connection = Null_Connection_Id THEN
         RETURN False;
      END IF;


      CASE Connection.Kind IS
         WHEN Server | Client =>
            RETURN Connection.Socket_Status = Connected;
         WHEN OTHERS =>
            RETURN False;
      END CASE;
   END Is_Connected;



   PROCEDURE Transmit (Connection :     Transport.Connection_Id;
                       Status     : OUT Transport_Defs.Status_Code;
                       Data       :     Byte_Defs.Byte_String;
                       Count      : OUT Natural;
                       Max_Wait   :     Duration := Duration'Last;
                       More       :     Boolean  := False) IS

      File_Descriptor    : Unix_Base_Types.Int;
      System_Call_Result : Unix_Base_Types.Int;
      Errno              : Unix_Base_Types.Int;
      Temp_Connect       : Transport.Connection_Id := Connection;
      Amount_Remaining   : Natural                 := Data'Length;
      Index              : Natural                 := Data'First;
      Lcount             : Natural                 := 0;

   BEGIN

      Count := 0;

      IF Temp_Connect = Null_Connection_Id THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      END IF;

      IF Temp_Connect.Socket_Status /= Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      Status := Transport_Defs.Ok;

      IF Temp_Connect.Kind = Server THEN  
         File_Descriptor := Temp_Connect.Tcp_Socket_Descriptor;
      ELSE
         File_Descriptor := Temp_Connect.Local_Socket_Descriptor;
      END IF;

      Transmit_Loop:
         WHILE Amount_Remaining > 0 LOOP

            Start_System_Call;

            System_Call_Result :=  
               System_Interface.File_Io.Write
                  (Fildes => File_Descriptor,
                   Buf => Unix_Base_Types.To_Char_Ptr (Data (Index)'Address),
                   Nbyte => Amount_Remaining);

            Errno := Finish_System_Call;

            IF (System_Call_Result < 0) THEN

               Status := Convert_Errno (Errno => Errno);

               IF Temp_Connect.Kind = Client THEN
                  System_Call_Result :=  
                     Socket_System_Interface.Shutdown
                        (S => File_Descriptor, How => 2);
               END IF;

               System_Call_Result :=  
                  System_Interface.File_Io.Close (Fildes => File_Descriptor);

               IF System_Call_Result < 0 THEN
                  RAISE Program_Error;
               ELSE

                  IF Temp_Connect.Kind = Server THEN  
                     Temp_Connect.Tcp_Socket_Descriptor := Unix_Error;
                     Temp_Connect.Socket_Status         := Not_Connected;
                  ELSE
                     Temp_Connect.Local_Socket_Descriptor := Unix_Error;
                     Temp_Connect.Socket_Status           := Closed;
                  END IF;

               END IF;

               RETURN;

            END IF;

            Lcount           := Lcount + System_Call_Result;
            Amount_Remaining := Amount_Remaining - System_Call_Result;
            Index            := Index + System_Call_Result;  
            Count            := Lcount;

         END LOOP Transmit_Loop;

   END Transmit;


   PROCEDURE Receive (Connection :     Transport.Connection_Id;
                      Status     : OUT Transport_Defs.Status_Code;
                      Data       : OUT Byte_Defs.Byte_String;
                      Count      : OUT Natural;
                      Max_Wait   :     Duration := Duration'Last) IS

      File_Descriptor    : Unix_Base_Types.Int;
      Length             : Unix_Base_Types.Int;
      System_Call_Result : Unix_Base_Types.Int;
      Errno              : Unix_Base_Types.Int := System_Interface.Error.Eintr;
      Temp_Connect       : Transport.Connection_Id := Connection;

   BEGIN

      Count := 0;

      IF Temp_Connect = Null_Connection_Id THEN
         Status := Transport_Defs.Not_Open;
         RETURN;
      END IF;

      IF Temp_Connect.Socket_Status /= Connected THEN
         Status := Transport_Defs.Not_Connected;
         RETURN;
      END IF;

      IF Temp_Connect.Kind = Server THEN  
         File_Descriptor := Temp_Connect.Tcp_Socket_Descriptor;
      ELSE
         File_Descriptor := Temp_Connect.Local_Socket_Descriptor;
      END IF;

      Status := Transport_Defs.Ok;

      Start_System_Call;

      Length := System_Interface.File_Io.Read
                   (Fildes => File_Descriptor,
                    Buf    => Unix_Base_Types.To_Char_Ptr (Data'Address),
                    Nbyte  => Data'Length);

      Errno := Finish_System_Call;

      IF (Length > 0) THEN

         Count := Length;

      ELSE


         IF (Length < 0) THEN

            Status := Convert_Errno (Errno => Errno);

         ELSIF (Length = 0) THEN

            Status := Transport_Defs.Not_Connected;

         END IF;

         IF Temp_Connect.Kind = Client THEN
            System_Call_Result :=  
               Socket_System_Interface.Shutdown
                  (S => File_Descriptor, How => 2);
         END IF;

         System_Call_Result :=  
            System_Interface.File_Io.Close (Fildes => File_Descriptor);

         IF System_Call_Result < 0 THEN
            RAISE Program_Error;
         ELSE

            IF Temp_Connect.Kind = Server THEN  
               Temp_Connect.Tcp_Socket_Descriptor := Unix_Error;
               Temp_Connect.Socket_Status         := Not_Connected;
            ELSE
               Temp_Connect.Local_Socket_Descriptor := Unix_Error;
               Temp_Connect.Socket_Status           := Closed;
            END IF;

         END IF;

      END IF;

   END Receive;
   FUNCTION Network (Connection : Transport.Connection_Id)
                    RETURN Transport_Defs.Network_Name IS
   BEGIN
      RETURN "TCP/IP"; --[prototype]
   END Network;


   FUNCTION Local_Host (Connection : Transport.Connection_Id)
                       RETURN Transport_Defs.Host_Id IS
   BEGIN
      RAISE Prototype_Error; --[prototype]
      RETURN Transport_Defs.Null_Host_Id;
   END Local_Host;


   FUNCTION Local_Socket (Connection : Transport.Connection_Id)
                         RETURN Transport_Defs.Socket_Id IS

      Sid : CONSTANT Transport_Defs.Socket_Id :=
         Transport_Defs.Socket_Id'
            (Byte_Defs.Byte
                (Integer (Connection.Local_Sockaddr_In.Sin_Port) / 256),
             Byte_Defs.Byte
                (Integer (Connection.Local_Sockaddr_In.Sin_Port) MOD 256));
   BEGIN

      RETURN Sid;

   END Local_Socket;


   FUNCTION Remote_Host (Connection : Transport.Connection_Id)
                        RETURN Transport_Defs.Host_Id IS
   BEGIN
      RAISE Prototype_Error; --[prototype]
      RETURN Transport_Defs.Null_Host_Id;
   END Remote_Host;


   FUNCTION Remote_Socket (Connection : Transport.Connection_Id)
                          RETURN Transport_Defs.Socket_Id IS
   BEGIN
      RETURN
         Transport_Defs.Socket_Id'
            (Byte_Defs.Byte
                (Integer (Connection.Remote_Sockaddr_In.Sin_Port) / 256),
             Byte_Defs.Byte
                (Integer (Connection.Remote_Sockaddr_In.Sin_Port) MOD 256));
   END Remote_Socket;
END Transport;
DataMuseum.dk

Rational R1000/400 Tapes

⟦693fefb72⟧ TextFile

Derivation

TextFile
