|
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: 16054 (0x3eb6)
Types: TextFile
Names: »B«
└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
└─ ⟦bb34fe6e2⟧ »DATA«
└─⟦15d8b76c6⟧
└─⟦this⟧
with Byte_Defs;
with Socket_System_Interface;
with System_Interface;
with Unix_Base_Types;
package body Transport is
function ">" (L, R : Byte_Defs.Byte) return Boolean renames Byte_Defs.">";
function "-" (L, R : Byte_Defs.Byte) return Byte_Defs.Byte
renames Byte_Defs."-";
type Connection_Info is
record
Connection_Establishment_Socket : Unix_Base_Types.Int := -1;
Transmission_Socket : Unix_Base_Types.Int := -1;
Next : Connection_Id := null;
end record;
Free_List : Connection_Id := null;
function "=" (L, R : Byte_Defs.Byte_String) return Boolean
renames Byte_Defs."=";
function Get return Connection_Id is
The_Connection : Connection_Id;
begin
if Free_List = null then
The_Connection := new Connection_Info;
else
The_Connection := Free_List;
Free_List := Free_List.Next;
end if;
return The_Connection;
end Get;
procedure Free (Connection : Connection_Id) is
begin
Connection.Next := Free_List;
Free_List := Connection;
end Free;
procedure Start_System_Call is
begin
null;
end Start_System_Call;
function Finish_System_Call return Unix_Base_Types.Int is
Errno : Integer := System_Interface.Error.Errno;
begin
return Errno;
end Finish_System_Call;
function Convert_Errno (Errno : Unix_Base_Types.Int)
return Transport_Defs.Status_Code is
begin
case Errno is
when System_Interface.Error.Econnreset |
System_Interface.Error.Eremoterelease =>
return Transport_Defs.Connection_Broken;
when System_Interface.Error.Enomem =>
return Transport_Defs.No_Free_Memory;
when System_Interface.Error.Eacces =>
return Transport_Defs.Access_Denied;
when System_Interface.Error.Eprotonosupport =>
return Transport_Defs.Protocol_Not_Supported;
when System_Interface.Error.Eaddrinuse =>
return Transport_Defs.Socket_In_Use;
when System_Interface.Error.Enetunreach =>
return Transport_Defs.Network_Unreachable;
when System_Interface.Error.Enotconn =>
return Transport_Defs.Not_Connected;
when System_Interface.Error.Eshutdown =>
return Transport_Defs.Not_Open;
when System_Interface.Error.Etimedout =>
return Transport_Defs.Timed_Out;
when System_Interface.Error.Econnrefused =>
return Transport_Defs.Connection_Refused;
when System_Interface.Error.Ehostunreach =>
return Transport_Defs.Host_Unreachable;
when others =>
return Transport_Defs.Status_Code
(Errno + Unix_Base_Types.Int (100));
end case;
end Convert_Errno;
function Byte_String_To_Integer
(Bs : Byte_Defs.Byte_String) return Unix_Base_Types.Int is
Result : Unix_Base_Types.Int := 0;
Int_Length : constant := 4;
Normalized_Bs : Byte_Defs.Byte_String (0 .. Int_Length - 1) :=
(others => 0);
Negative : Boolean := False;
Shifter : Integer := 0;
begin
if Bs'Length < Int_Length then
Normalized_Bs
((Normalized_Bs'Last - Bs'Length) + 1 .. Normalized_Bs'Last) :=
Bs;
else
Normalized_Bs := Bs ((Bs'Last - Int_Length) + 1 .. Bs'Last);
end if;
if Normalized_Bs (0) > Byte_Defs.Byte (2 ** 7 - 1) then
Negative := True;
end if;
for I in reverse Normalized_Bs'Range loop
if Negative then
Normalized_Bs (I) := Byte_Defs.Byte'Last - Normalized_Bs (I);
end if;
Result := Result + Integer (Normalized_Bs (I)) * (2 ** Shifter);
Shifter := Shifter + 8;
end loop;
if Negative then
return -Result - 1;
else
return Result;
end if;
end Byte_String_To_Integer;
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
System_Call_Result : Integer;
Lconnection : Connection_Id := Null_Connection_Id;
Addr : 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 (Local_Socket)))),
Sin_Addr => Socket_System_Interface.Inaddr_Any,
Sin_Zero => (others => Ascii.Nul));
Errno : Integer;
begin
Connection := Null_Connection_Id;
Status := Transport_Defs.Ok;
Start_System_Call;
System_Call_Result :=
Socket_System_Interface.Socket
(Af => Unix_Base_Types.Int (Socket_System_Interface.Af_Inet),
Socket_Type => Socket_System_Interface.Sock_Stream,
Protocol => 0);
Errno := Finish_System_Call;
if System_Call_Result = -1 then
Status := Convert_Errno (Errno);
return;
end if;
Lconnection := Get;
Lconnection.Connection_Establishment_Socket := System_Call_Result;
if Byte_Defs.Byte_String (Local_Socket) /=
Byte_Defs.Byte_String (Transport_Defs.Null_Socket_Id) then
Start_System_Call;
System_Call_Result :=
Socket_System_Interface.Bind
(S => Unix_Base_Types.Int
(Lconnection.Connection_Establishment_Socket),
Addr => Addr,
Addrlen => 16);
Errno := Finish_System_Call;
if System_Call_Result = -1 then
Status := Convert_Errno (Errno);
System_Call_Result :=
System_Interface.File_Io.Close
(Fildes => Lconnection.Connection_Establishment_Socket);
Free (Lconnection);
return;
end if;
end if;
Connection := Lconnection;
end Open;
procedure Close (Connection : Transport.Connection_Id) is
Error : Unix_Base_Types.Int;
Lconnection : Connection_Id := Connection;
begin
if Connection /= Null_Connection_Id then
Error := Socket_System_Interface.Shutdown
(S => Connection.Transmission_Socket, How => 2);
Error := System_Interface.File_Io.Close
(Connection.Transmission_Socket);
Error := Socket_System_Interface.Shutdown
(S => Connection.Connection_Establishment_Socket,
How => 2);
Error := System_Interface.File_Io.Close
(Connection.Connection_Establishment_Socket);
Lconnection.Connection_Establishment_Socket := -1;
Lconnection.Transmission_Socket := -1;
Free (Lconnection);
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
System_Call_Result : Integer;
Errno : Integer := System_Interface.Error.Etimedout;
Addr : 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));
begin
if not Is_Open (Connection) then
Status := Transport_Defs.Not_Open;
return;
end if;
Status := Transport_Defs.Ok;
while Errno = System_Interface.Error.Etimedout loop
Start_System_Call;
System_Call_Result :=
Socket_System_Interface.Connect
(S => Connection.Connection_Establishment_Socket,
Addr => Addr,
Addrlen => 16);
Errno := Finish_System_Call;
end loop;
if System_Call_Result = -1 then
Status := Convert_Errno (Errno);
else
Connection.Transmission_Socket :=
Connection.Connection_Establishment_Socket;
end if;
end Connect;
procedure Connect (Connection : Transport.Connection_Id;
Status : out Transport_Defs.Status_Code;
Max_Wait : Duration := Duration'Last) is
System_Call_Result : Integer;
Errno : Integer := 0;
Addr : Socket_System_Interface.Sockaddr;
begin
if not Is_Open (Connection) then
Status := Transport_Defs.Not_Open;
return;
end if;
Status := Transport_Defs.Ok;
Start_System_Call;
System_Call_Result :=
Socket_System_Interface.Listen
(S => Connection.Connection_Establishment_Socket, Backlog => 5);
Errno := Finish_System_Call;
if System_Call_Result = -1 then
Status := Convert_Errno (Errno);
else
loop
Start_System_Call;
System_Call_Result :=
Socket_System_Interface.Saccept
(S => Connection.Connection_Establishment_Socket,
Addr => Addr,
Addrlen => 16);
Errno := Finish_System_Call;
exit when Errno /= System_Interface.Error.Eintr;
end loop;
if System_Call_Result = -1 then
Status := Convert_Errno (Errno);
else
Connection.Transmission_Socket := System_Call_Result;
end if;
end if;
end Connect;
procedure Disconnect (Connection : Transport.Connection_Id) is
Error : Integer;
begin
if Connection /= Null_Connection_Id and then
Connection.Transmission_Socket /= -1 then
Error := Socket_System_Interface.Shutdown
(S => Connection.Transmission_Socket, How => 2);
Connection.Transmission_Socket := -1;
end if;
end Disconnect;
function Is_Open (Connection : Transport.Connection_Id) return Boolean is
begin
return Connection /= Null_Connection_Id and then
Connection.Connection_Establishment_Socket /= -1;
end Is_Open;
function Is_Connected
(Connection : Transport.Connection_Id) return Boolean is
begin
return Connection /= Null_Connection_Id and then
Connection.Transmission_Socket /= -1;
--should be getpeername;
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
System_Call_Result : Integer := 1;
Errno : Integer := 0;
Bytes_Sent : Integer := 0;
function Disconnected return Boolean is
begin
return System_Call_Result = 0;
end Disconnected;
function More_Data return Boolean is
begin
return Bytes_Sent < Data'Length;
end More_Data;
function No_Error return Boolean is
begin
return Errno = 0 or Errno = System_Interface.Error.Eintr;
end No_Error;
begin
Count := 0;
Status := Transport_Defs.Ok;
if not Is_Open (Connection) then
Status := Transport_Defs.Not_Open;
return;
end if;
if not Is_Connected (Connection) then
Status := Transport_Defs.Not_Connected;
return;
end if;
while No_Error and More_Data and not Disconnected loop
declare
Buffer : constant Byte_Defs.Byte_String :=
Data (Data'First + Bytes_Sent .. Data'Last);
begin
Start_System_Call;
System_Call_Result :=
System_Interface.File_Io.Write
(Fildes => Connection.Transmission_Socket,
Buf => Unix_Base_Types.To_Char_Ptr (Buffer'Address),
Nbyte => Buffer'Length);
Errno := Finish_System_Call;
end;
if System_Call_Result /= -1 then
Bytes_Sent := Bytes_Sent + System_Call_Result;
end if;
end loop;
Count := Bytes_Sent;
if System_Call_Result = -1 then
Status := Convert_Errno (Errno);
return;
end if;
if Disconnected then
Status := Transport_Defs.Connection_Broken;
System_Call_Result := Socket_System_Interface.Shutdown
(Connection.Transmission_Socket, 2);
System_Call_Result := System_Interface.File_Io.Close
(Connection.Transmission_Socket);
Connection.Transmission_Socket := -1;
end if;
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
System_Call_Result : Integer;
Errno : Integer;
begin
Count := 0;
Status := Transport_Defs.Ok;
if not Is_Open (Connection) then
Status := Transport_Defs.Not_Open;
end if;
if not Is_Connected (Connection) then
Status := Transport_Defs.Not_Connected;
end if;
loop
Start_System_Call;
System_Call_Result := System_Interface.File_Io.Read
(Fildes => Connection.Transmission_Socket,
Buf => Unix_Base_Types.To_Char_Ptr
(Data (Data'First)'Address),
Nbyte => Data'Length);
Errno := Finish_System_Call;
exit when Errno /= System_Interface.Error.Eintr;
end loop;
if System_Call_Result = -1 then
Status := Convert_Errno (Errno);
return;
end if;
if System_Call_Result = 0 then
Status := Transport_Defs.Connection_Broken;
System_Call_Result := Socket_System_Interface.Shutdown
(Connection.Transmission_Socket, 2);
System_Call_Result := System_Interface.File_Io.Close
(Connection.Transmission_Socket);
Connection.Transmission_Socket := -1;
else
Count := System_Call_Result;
end if;
end Receive;
end Transport;