|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 23552 (0x5c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Transport, seg_052ab5
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
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;
nblk1=16
nid=b
hdr6=2a
[0x00] rec0=21 rec1=00 rec2=01 rec3=018
[0x01] rec0=1a rec1=00 rec2=02 rec3=058
[0x02] rec0=1e rec1=00 rec2=03 rec3=00a
[0x03] rec0=1c rec1=00 rec2=04 rec3=060
[0x04] rec0=16 rec1=00 rec2=05 rec3=082
[0x05] rec0=1a rec1=00 rec2=06 rec3=01a
[0x06] rec0=15 rec1=00 rec2=07 rec3=034
[0x07] rec0=1f rec1=00 rec2=08 rec3=010
[0x08] rec0=20 rec1=00 rec2=09 rec3=01c
[0x09] rec0=1b rec1=00 rec2=0a rec3=030
[0x0a] rec0=20 rec1=00 rec2=16 rec3=024
[0x0b] rec0=21 rec1=00 rec2=0c rec3=00c
[0x0c] rec0=1f rec1=00 rec2=0d rec3=05a
[0x0d] rec0=21 rec1=00 rec2=0e rec3=006
[0x0e] rec0=1a rec1=00 rec2=0f rec3=058
[0x0f] rec0=1e rec1=00 rec2=10 rec3=058
[0x10] rec0=1d rec1=00 rec2=11 rec3=012
[0x11] rec0=26 rec1=00 rec2=12 rec3=012
[0x12] rec0=1e rec1=00 rec2=13 rec3=00a
[0x13] rec0=20 rec1=00 rec2=14 rec3=010
[0x14] rec0=07 rec1=00 rec2=15 rec3=000
[0x15] rec0=00 rec1=04 rec2=80 rec3=016
tail 0x21759fe9487a14f34e032 0x42a00088462060003
Free Block Chain:
0xb: 0000 00 00 03 fc 80 05 69 66 3b 20 20 05 00 14 20 20 ┆ if; ┆