|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 19211 (0x4b0b)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
WITH Byte_Defs;
WITH Socket_System_Interface;
WITH System;
WITH System_Interface;
WITH Transport_Defs;
WITH Unchecked_Conversion;
WITH Unix_Base_Types;
PACKAGE BODY Transport IS
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
Temp_Connect : Transport.Connection_Id := Connection;
System_Call_Result : Unix_Base_Types.Int;
BEGIN
IF Connection = Null_Connection_Id THEN
RETURN;
END IF;
IF Temp_Connect.Socket_Status = Connected THEN
Transport.Disconnect (Connection => Temp_Connect);
END IF;
IF Temp_Connect.Socket_Status = Open OR
Temp_Connect.Socket_Status = Not_Connected THEN
System_Call_Result :=
Socket_System_Interface.Shutdown
(S => Temp_Connect.Local_Socket_Descriptor, How => 2);
System_Call_Result :=
System_Interface.File_Io.Close
(Fildes => Temp_Connect.Local_Socket_Descriptor);
IF System_Call_Result < 0 THEN
RAISE Program_Error;
ELSE
Temp_Connect.Local_Socket_Descriptor := Unix_Error;
Temp_Connect.Socket_Status := Closed;
END IF;
END IF;
END Close;
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;
PROCEDURE Set_Mode (Connection : Transport.Connection_Id;
Status : OUT Transport_Defs.Status_Code;
Blocking : Boolean := True) IS
System_Call_Result : Unix_Base_Types.Int;
Errno : Unix_Base_Types.Int;
Not_Used : CONSTANT Integer := 1;
Not_Implemented_Error : EXCEPTION;
BEGIN
IF Blocking THEN
System_Call_Result :=
System_Interface.File_Io.Ioctl
(Fildes => Connection.Local_Socket_Descriptor,
Request => System_Interface.File_Io.Fionbio,
Arg => Not_Used);
ELSE
RAISE Not_Implemented_Error; --[may be done fcntl]
END IF;
IF (System_Call_Result < 0) THEN
Status := Convert_Errno (Errno => Errno);
RETURN;
END IF;
END Set_Mode;
END Transport;