DataMuseum.dk

top - metrics - download

    Length: 37575 (0x92c7)
    Types: TextFile
    Names: »TRANSPORT_BODY«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Vms;
with Ip_Tcp_Defs;
with Byte_Defs;
with Text_Io;
with System;

--with Transport_Defs, Starlet, Tasking_Services, Rms_Asynch_Operations,
--     Condition_Handling;
--with Implementation_Dependent_Types; -- Last two conext clauses added due to
-- CG bug --jaa

package body Transport is

    Local_Host_Id : constant Transport_Defs.Host_Id (1 .. 4) := (89, 64, 3, 22);

    Buffer_Size : constant := 1024;

    Print_Enabled : Boolean := False;



    task type Transmitter_Type is
        entry Connect (Connection : Transport.Connection_Id);
        entry Disconnect;
        entry Transmit (Status : out Transport_Defs.Status_Code;
                        Data : Byte_Defs.Byte_String;
                        Count : out Natural);
    end Transmitter_Type;

    task type Receiver_Type is
        entry Connect (Connection : Transport.Connection_Id);
        entry Disconnect;
        entry Receive (Status : out Transport_Defs.Status_Code;
                       Data : out Byte_Defs.Byte_String;
                       Count : out Natural);
    end Receiver_Type;

    type Connection_Type is
        record
            Is_Open : Boolean := False;
            Is_Connecting_Active : Boolean := False;
            Is_Connecting_Passive : Boolean := False;
            Is_Connected : Boolean := False;
            Channel : Vms.Channel_Type;
            Local_Port : Ip_Tcp_Defs.Port_Number;
            Remote_Host : Ip_Tcp_Defs.Internet_Address;
            Remote_Port : Ip_Tcp_Defs.Port_Number :=
               Ip_Tcp_Defs.Null_Port_Number;
            Transmitter : Transmitter_Type;
            Receiver : Receiver_Type;
            Next : Connection_Id;                           -- for chained lists
        end record;

    task type Socket_Manager is
        entry Initialize (Local_Socket : Transport_Defs.Socket_Id;
                          Status : out Transport_Defs.Status_Code);
        entry Passive_Connect (Connection : Transport.Connection_Id;
                               Status : out Transport_Defs.Status_Code);
    end Socket_Manager;

    type Socket_Type;

    type Socket_List is access Socket_Type;

    type Socket_Type is
        record
            Local_Port : Ip_Tcp_Defs.Port_Number;
            Manager : Socket_Manager;
            Last_Status : Transport_Defs.Status_Code := Transport_Defs.Ok;
            Next : Socket_List := null;
        end record;

    task Socket_Pool is
        entry Get (Socket : out Socket_List;
                   Local_Port : Ip_Tcp_Defs.Port_Number);
    end Socket_Pool;

    task Connection_Pool is
        entry Get (Connection : out Transport.Connection_Id;
                   Status : out Transport_Defs.Status_Code;
                   Local_Socket : Transport_Defs.Socket_Id);
        -- Allocate a connection object, and set its Port.
        -- If null_socket_id is supplied, invent a socket.

        entry Put (Connection : Transport.Connection_Id);
        entry Init (Iter : in out Connection_Id_Iterator);
        entry Next (Iter : in out Connection_Id_Iterator);
    end Connection_Pool;

    task Port_Number_Generator is
        entry Invent (Answer : out Ip_Tcp_Defs.Port_Number);
    end Port_Number_Generator;

    subtype Defined_Errors is Ip_Tcp_Defs.Unix_Error.Number range 1 .. 69;

    type Error_Map_Type is array (Defined_Errors) of Transport_Defs.Status_Code;

    use Ip_Tcp_Defs.Unix_Error;

    Error_Map : constant Error_Map_Type :=
       Error_Map_Type'(Eperm => Transport_Defs.Access_Denied,
                       Enxio => Transport_Defs.No_Hardware,
                       Enomem => Transport_Defs.No_Local_Resources,
                       Eacces => Transport_Defs.Access_Denied,
                       Epipe => Transport_Defs.Connection_Broken,
                       Eaddrinuse => Transport_Defs.Socket_In_Use,
                       Enetdown => Transport_Defs.No_Such_Network,
                       Enetunreach => Transport_Defs.No_Such_Network,
                       Enetreset => Transport_Defs.Connection_Broken,
                       Econnaborted => Transport_Defs.Connection_Broken,
                       Econnreset => Transport_Defs.Connection_Broken,
                       Enobufs => Transport_Defs.No_Free_Memory,
                       Etoomanyrefs => Transport_Defs.Too_Many_Clients,
                       Etimedout => Transport_Defs.Timed_Out,
                       Econnrefused => Transport_Defs.Connection_Refused,
                       Ehostdown => Transport_Defs.No_Such_Host,
                       Ehostunreach => Transport_Defs.No_Such_Host,
                       others => Transport_Defs.Not_Connected);

    function To_Unsigned_Longword (X : Vms.Address) return Vms.Unsigned_Longword
        renames Vms.To_Unsigned_Longword;

    function To_Byte_Count (Size : Vms.Unsigned_Longword)
                           return Vms.Unsigned_Longword
        renames Vms.To_Byte_Count;

    function Is_Ok (Status : Vms.Cond_Value_Type) return Boolean
        renames Vms.Success;

    function Image (Status : Vms.Cond_Value_Type) return String
        renames Vms.Image;

    function Image (Iosb : Vms.Iosb_Type) return String renames Vms.Image;

    function Image (X : Ip_Tcp_Defs.Sockaddr_In) return String is
    begin
        return "(family" &
                  Ip_Tcp_Defs.Address_Family_Type'Image (X.Sin_Family) &
                  ", port" &
                  System.Unsigned_Byte'Image (X.Sin_Port (0)) &
                  System.Unsigned_Byte'Image (X.Sin_Port (1)) &
                  ", addr" &
                  System.Unsigned_Byte'Image (X.Sin_Addr.S_Addr (0)) &
                  System.Unsigned_Byte'Image (X.Sin_Addr.S_Addr (1)) &
                  System.Unsigned_Byte'Image (X.Sin_Addr.S_Addr (2)) &
                  System.Unsigned_Byte'Image (X.Sin_Addr.S_Addr (3)) & ")";
    end Image;

    procedure Print (Line : String) is
    begin
        if Print_Enabled then
            Text_Io.Put_Line (Line);
        end if;
    end Print;

    procedure Print (Status : Vms.Cond_Value_Type) is
    begin
        if Print_Enabled then
            Vms.Put_Msg (Status);
        end if;
    end Print;

    procedure Print (Operation_Name : String; Status : Vms.Cond_Value_Type) is
    begin
        if not Is_Ok (Status) then
            Print (Operation_Name & ": status => " & Image (Status));
            Print (Status);
        end if;
    end Print;

    procedure Print (Operation_Name : String;
                     Status : Vms.Cond_Value_Type;
                     Iosb : Vms.Iosb_Type) is
    begin
        if (not Is_Ok (Status)) or else
           (not Is_Ok (Vms.Cond_Value_Type (Iosb.Status))) then
            Print (Operation_Name & ": status => " & Image (Status));

            if not Is_Ok (Status) then
                Print (Status);
            end if;

            Print ("    iosb => " & Image (Iosb));

            if not Is_Ok (Vms.Cond_Value_Type (Iosb.Status)) then
                Print (Vms.Cond_Value_Type (Iosb.Status));
            end if;
        end if;
    end Print;

    procedure Print (Name : String; Value : Ip_Tcp_Defs.Sockaddr_In) is
    begin
        Print (Name & " => " & Image (Value));
    end Print;

    procedure Print (Name : String; Value : Ip_Tcp_Defs.Bit_16) is
    begin
        Print (Name & " => " & Ip_Tcp_Defs.Bit_16'Image (Value));
    end Print;

    procedure Print (Name : String; Value : Ip_Tcp_Defs.Bit_32) is
    begin
        Print (Name & " => " & Ip_Tcp_Defs.Bit_32'Image (Value));
    end Print;

    function Convert (X : Ip_Tcp_Defs.Port_Number)
                     return Transport_Defs.Socket_Id is
    begin
        if Ip_Tcp_Defs."=" (X, Ip_Tcp_Defs.Null_Port_Number) then
            return Transport_Defs.Null_Socket_Id;
        else
            return Transport_Defs.Socket_Id (X);
        end if;
    end Convert;

    function Convert (X : Transport_Defs.Socket_Id)
                     return Ip_Tcp_Defs.Port_Number is
        Answer : Ip_Tcp_Defs.Port_Number;
    begin
        for I in 0 .. Integer (Answer'Length) - 1 loop
            if I >= X'Length then
                Answer (Answer'Last - I) := 0;
            else
                Answer (Answer'Last - I) := X (X'Last - I);
            end if;
        end loop;

        return Answer;
    end Convert;

    function Convert (X : Ip_Tcp_Defs.Internet_Address)
                     return Transport_Defs.Host_Id is
    begin
        return Transport_Defs.Host_Id (X);
    end Convert;

    function Convert (X : Transport_Defs.Host_Id)
                     return Ip_Tcp_Defs.Internet_Address is
        Answer : Ip_Tcp_Defs.Internet_Address;
    begin
        for I in 0 .. Integer (Answer'Length) - 1 loop
            if I >= X'Length then
                Answer (Answer'Last - I) := 0;
            else
                Answer (Answer'Last - I) := X (X'Last - I);
            end if;
        end loop;

        return Answer;
    end Convert;

    function Convert (X : Vms.Cond_Value_Type)
                     return Transport_Defs.Status_Code is
    begin
        case X is
            when Vms.Cond_Value_Type'(Ip_Tcp_Defs.Ss_Normal) =>
                return Transport_Defs.Ok;
            when others =>
                return Error_Map (Ip_Tcp_Defs.Unix_Error.Decode (X));
        end case;
    end Convert;

    task body Port_Number_Generator is
        type Port_Number is range 1024 .. 2 ** 16 - 1;
        Seed : Port_Number := Port_Number'First;
    begin
        loop
            accept Invent (Answer : out Ip_Tcp_Defs.Port_Number) do
                Answer := (Byte_Defs.Byte (Seed / 256),
                           Byte_Defs.Byte (Seed mod 256));
            end Invent;

            if Seed = Port_Number'Last then
                Seed := Port_Number'First;
            else
                Seed := Seed + 1;
            end if;
        end loop;
    end Port_Number_Generator;

    function Invent_Port_Number return Ip_Tcp_Defs.Port_Number is
        Answer : Ip_Tcp_Defs.Port_Number;
    begin
        Port_Number_Generator.Invent (Answer);
        return Answer;
    end Invent_Port_Number;

    task body Socket_Pool is
        The_Pool : Socket_List := null;
        Answer : Socket_List;
        use Ip_Tcp_Defs;
    begin
        loop
            accept Get (Socket : out Socket_List;
                        Local_Port : Ip_Tcp_Defs.Port_Number) do
                Answer := The_Pool;

                while Answer /= null and then
                         Answer.Local_Port /= Get.Local_Port loop
                    Answer := Answer.Next;
                end loop;

                if Answer = null then
                    Answer := new Socket_Type;
                    Answer.Local_Port := Get.Local_Port;
                    Answer.Manager.Initialize
                       (Convert (Answer.Local_Port), Answer.Last_Status);
                    Answer.Next := The_Pool;
                    The_Pool := Answer;
                end if;

                Socket := Answer;
            end Get;
        end loop;
    end Socket_Pool;

    task body Connection_Pool is
        Free_List : Connection_Id := null;
        Open_List : Connection_Id := null;
    begin
        loop
            begin
                select
                    accept Get (Connection : out Transport.Connection_Id;
                                Status : out Transport_Defs.Status_Code;
                                Local_Socket : Transport_Defs.Socket_Id) do
                        declare
                            Answer : Transport.Connection_Id;
                        begin
                            if Free_List = null then
                                Answer := new Connection_Type;
                            else
                                Answer := Free_List;
                                Free_List := Answer.Next;
                            end if;

                            Answer.Local_Port := Convert (Local_Socket);
                            Answer.Next := Open_List;
                            Open_List := Answer;
                            Connection := Answer;
                            Status := Transport_Defs.Ok;
                        end;
                    end Get;
                or
                    accept Put (Connection : Transport.Connection_Id) do
                        if Open_List = Connection then
                            Open_List := Connection.Next;
                        else
                            declare
                                Cursor : Connection_Id := Open_List;
                            begin
                                while Cursor.Next /= Connection loop
                                    Cursor := Cursor.Next;
                                end loop;

                                Cursor.Next := Connection.Next;
                            end;
                        end if;

                        Connection.Next := Free_List;
                        Free_List := Connection;
                    end Put;
                or
                    accept Init (Iter : in out Connection_Id_Iterator) do
                        Iter := Connection_Id_Iterator (Open_List);
                    end Init;
                or
                    accept Next (Iter : in out Connection_Id_Iterator) do
                        if Iter /= null then
                            Iter := Connection_Id_Iterator (Iter.Next);
                        end if;
                    end Next;
                end select;
            exception
                when others =>
                    null;
            end;
        end loop;
    end Connection_Pool;

    procedure Do_Assign (Out_Cc : out Vms.Cond_Value_Type;
                         Conn : Transport.Connection_Id) is
        Cc : Vms.Cond_Value_Type;
        Iosb : Vms.Iosb_Type;
    begin
        Vms.Assign (Status => Cc,
                    Chan => Conn.Channel,
                    Devnam => Ip_Tcp_Defs.The_Device);
        Print ("ASSIGN", Cc);

        if Is_Ok (Cc) then
            Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Socket,
                      Status => Cc,
                      Iosb => Vms.Address (Iosb'Address),
                      Chan => Conn.Channel,
                      P1 => Vms.Unsigned_Longword (Ip_Tcp_Defs.Af_Inet),
                      P2 => Vms.Unsigned_Longword (Ip_Tcp_Defs.Sock_Stream));
            Print ("IO_SOCKET", Cc, Iosb);
            Cc := Vms.Cond_Value_Type (Iosb.Status);
        end if;

        Out_Cc := Cc;
    end Do_Assign;

    task body Socket_Manager is
        Connection : Connection_Id;
        The_Status : Transport_Defs.Status_Code;
        Sin : Ip_Tcp_Defs.Sockaddr_In;
        Cc : Vms.Cond_Value_Type;
        Iosb : Vms.Iosb_Type;
        New_Channel : Vms.Channel_Type;
        Io_Accept_Return : Ip_Tcp_Defs.Io_Accept_Return_Type;

        procedure Do_Initialize is
        begin
            Do_Assign (Cc, Connection);

            if Is_Ok (Cc) then
                Sin.Sin_Family := Ip_Tcp_Defs.Af_Inet;
                Sin.Sin_Addr.S_Addr := (others => 0);
                Sin.Sin_Port := Connection.Local_Port;
                Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Bind,
                          Status => Cc,
                          Iosb => Vms.Address (Iosb'Address),
                          Chan => Connection.Channel,
                          P1 => To_Unsigned_Longword (Sin'Address),
                          P2 => To_Byte_Count (Sin'Size));
                Print ("IO_BIND", Cc, Iosb);
                Cc := Vms.Cond_Value_Type (Iosb.Status);
            end if;

            if Is_Ok (Cc) then
                Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Listen,
                          Status => Cc,
                          Iosb => Vms.Address (Iosb'Address),
                          Chan => Connection.Channel,
                          P1 => 0);                            -- backlog
                Print ("IO_LISTEN", Cc, Iosb);
                Cc := Vms.Cond_Value_Type (Iosb.Status);
            end if;
        end Do_Initialize;

        procedure Get_New_Channel is
        begin
            Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Accept_Wait,
                      Status => Cc,
                      Iosb => Vms.Address (Iosb'Address),
                      Chan => Connection.Channel);
            Print ("IO_ACCEPT_WAIT", Cc, Iosb);
            Cc := Vms.Cond_Value_Type (Iosb.Status);

            if Is_Ok (Cc) then
                Vms.Assign (Status => Cc,
                            Chan => New_Channel,
                            Devnam => Ip_Tcp_Defs.The_Device);
                Print ("ASSIGN (passive connect)", Cc);
            end if;

            if Is_Ok (Cc) then
                Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Accept,
                          Status => Cc,
                          Iosb => Vms.Address (Iosb'Address),
                          Chan => New_Channel,
                          P1 => To_Unsigned_Longword (Io_Accept_Return'Address),
                          P2 => To_Byte_Count (Io_Accept_Return'Size),
                          P3 => Vms.Unsigned_Longword (Connection.Channel));
                Print ("IO_ACCEPT", Cc, Iosb);
                Print ("Addr_Size", Io_Accept_Return.Addr_Size);
                Print ("Foreign_Addr", Io_Accept_Return.Foreign_Addr);
                Cc := Vms.Cond_Value_Type (Iosb.Status);
            end if;

            if not Is_Ok (Cc) then
                Vms.Dassgn (Status => Cc, Chan => New_Channel);
                Print ("DASSGN passive", Cc);
            end if;
        end Get_New_Channel;

    begin
        accept Initialize (Local_Socket : Transport_Defs.Socket_Id;
                           Status : out Transport_Defs.Status_Code) do

            Transport.Open (Connection, The_Status, "TCP/IP", Local_Socket);

            if Transport_Defs."=" (The_Status, Transport_Defs.Ok) then
                Do_Initialize;
                Status := Convert (Cc);
            else
                Status := The_Status;
            end if;
        end Initialize;

        if Transport_Defs."=" (The_Status, Transport_Defs.Ok) then
            loop
                select
                    accept Passive_Connect
                              (Connection : Transport.Connection_Id;
                               Status : out Transport_Defs.Status_Code) do
                        Get_New_Channel;

                        if Is_Ok (Cc) then
                            Connection.Is_Connected := True;
                            Connection.Is_Connecting_Passive := False;
                            Connection.Channel := New_Channel;
                            Connection.Remote_Host :=
                               Io_Accept_Return.Foreign_Addr.Sin_Addr.S_Addr;
                            Connection.Remote_Port :=
                               Io_Accept_Return.Foreign_Addr.Sin_Port;
                            Connection.Transmitter.Connect (Connection);
                            Connection.Receiver.Connect (Connection);
                        end if;

                        Status := Convert (Cc);
                    end Passive_Connect;
                or
                    accept Initialize
                              (Local_Socket : Transport_Defs.Socket_Id;
                               Status : out Transport_Defs.Status_Code) do
                        -- somebody fucked up.
                        raise Constraint_Error;
                    end Initialize;
                end select;
            end loop;
        end if;
    end Socket_Manager;

    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
        Conn : Transport.Connection_Id := null;
        Cc : Vms.Cond_Value_Type;
        Stat : Transport_Defs.Status_Code;
    begin
        if Transport_Defs."="
              (Transport_Defs.Normalize (Network), "TCP/IP") then
            Connection_Pool.Get (Conn, Stat, Local_Socket);

            if Transport_Defs."=" (Stat, Transport_Defs.Ok) then
                Conn.Is_Open := True;
            end if;

        else
            Stat := Transport_Defs.No_Such_Network;
        end if;

        Connection := Conn;
        Status := Stat;
    end Open;

    procedure Close (Connection : Transport.Connection_Id) is
    begin
        if Is_Open (Connection) then
            Disconnect (Connection);
            Connection.Is_Open := False;
            Connection_Pool.Put (Connection);
        end if;
    end Close;

    procedure Connect (Connection : Transport.Connection_Id;
                       Status : out Transport_Defs.Status_Code;
                       Max_Wait : Duration := Duration'Last) is
        Socket : Socket_List;
    begin
        if Is_Open (Connection) then
            Connection.Is_Connecting_Passive := True;

            Socket_Pool.Get (Socket, Connection.Local_Port);

            select
                Socket.Manager.Passive_Connect (Connection, Status);
            or
                delay Max_Wait;
                Status := Transport_Defs.Timed_Out;
            end select;
        end if;
    exception
        when Tasking_Error =>
            Status := Socket.Last_Status;
    end Connect;

    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

        Sin : Ip_Tcp_Defs.Sockaddr_In;
        Cc : Vms.Cond_Value_Type;
        Iosb : Vms.Iosb_Type;

        Max_Attempts : Positive := 32;

        procedure Bind (Local_Port : Ip_Tcp_Defs.Port_Number) is
        begin
            Sin.Sin_Family := Ip_Tcp_Defs.Af_Inet;
            Sin.Sin_Addr.S_Addr := (others => 0);
            Sin.Sin_Port := Local_Port;
            Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Bind,
                      Status => Cc,
                      Iosb => Vms.Address (Iosb'Address),
                      Chan => Connection.Channel,
                      P1 => To_Unsigned_Longword (Sin'Address),
                      P2 => To_Byte_Count (Sin'Size));
            Print ("IO_BIND", Cc, Iosb);
            Cc := Vms.Cond_Value_Type (Iosb.Status);
        end Bind;

    begin
        if Is_Open (Connection) then
            Connection.Is_Connecting_Active := True;

            Do_Assign (Cc, Connection);

            if Is_Ok (Cc) then
                if Transport_Defs."=" (Convert (Connection.Local_Port),
                                       Transport_Defs.Null_Socket_Id) then
                    for Attempt in 1 .. Max_Attempts loop
                        Bind (Invent_Port_Number);
                        exit when Is_Ok (Cc);
                    end loop;
                else
                    Bind (Connection.Local_Port);
                end if;
            end if;

            if Is_Ok (Cc) then
                Sin.Sin_Family := Ip_Tcp_Defs.Af_Inet;
                Sin.Sin_Addr.S_Addr := Convert (Remote_Host);
                Sin.Sin_Port := Convert (Remote_Socket);
                Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Connect,
                          Status => Cc,
                          Iosb => Vms.Address (Iosb'Address),
                          Chan => Connection.Channel,
                          P1 => To_Unsigned_Longword (Sin'Address),
                          P2 => To_Byte_Count (Sin'Size));
                Print ("IO_CONNECT", Cc, Iosb);
                Cc := Vms.Cond_Value_Type (Iosb.Status);
            end if;

            if Is_Ok (Cc) then
                Connection.Is_Connected := True;
                Connection.Is_Connecting_Active := False;
                Connection.Transmitter.Connect (Connection);
                Connection.Receiver.Connect (Connection);
            else
                Close (Connection);
            end if;

            Status := Convert (Cc);
        end if;
    end Connect;

    procedure Disconnect (Connection : Transport.Connection_Id) is
        Cc : Vms.Cond_Value_Type;
    begin
        if Is_Open (Connection) then
            Vms.Dassgn (Status => Cc, Chan => Connection.Channel);
            Print ("DASSGN", Cc);
            Connection.Is_Connected := False;
            Connection.Transmitter.Disconnect;
            Connection.Receiver.Disconnect;
        end if;
    end Disconnect;

    function Is_Open (Connection : Transport.Connection_Id) return Boolean is
    begin
        return Connection /= null and then Connection.Is_Open;
    end Is_Open;

    function Is_Connecting_Passive
                (Connection : Transport.Connection_Id) return Boolean is
    begin
        return Connection /= null and then Connection.Is_Connecting_Passive;
    end Is_Connecting_Passive;

    function Is_Connecting_Active
                (Connection : Transport.Connection_Id) return Boolean is
    begin
        return Connection /= null and then Connection.Is_Connecting_Active;
    end Is_Connecting_Active;

    function Is_Connected
                (Connection : Transport.Connection_Id) return Boolean is
    begin
        return Connection /= null and then Connection.Is_Connected;
    end Is_Connected;

    procedure Blocking_Transmit (Connection : Transport.Connection_Id;
                                 Status : out Transport_Defs.Status_Code;
                                 Data : Byte_Defs.Byte_String;
                                 Count : out Natural) is
        Buffer : Byte_Defs.Byte_String (1 .. Data'Length) := Data;
        Cc : Vms.Cond_Value_Type;
        Iosb : Vms.Iosb_Type;
    begin
        if not Is_Connected (Connection) then
            Status := Transport_Defs.Not_Connected;
            Count := 0;
        else
            Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Send,
                      Status => Cc,
                      Chan => Connection.Channel,
                      Iosb => Vms.Address (Iosb'Address),
                      P1 => To_Unsigned_Longword (Buffer'Address),
                      P2 => To_Byte_Count (Buffer'Size));
            Print ("IO_SEND", Cc, Iosb);
            Cc := Vms.Cond_Value_Type (Iosb.Status);
            Count := Natural (Iosb.Count);

            if not Is_Ok (Cc) then
                Connection.Is_Connected := False;
                Status := Convert (Cc);
            else
                Status := Transport_Defs.Ok;
            end if;
        end if;
    end Blocking_Transmit;

    procedure Blocking_Receive (Connection : Transport.Connection_Id;
                                Status : out Transport_Defs.Status_Code;
                                Data : out Byte_Defs.Byte_String;
                                Count : out Natural) is
        Buffer : Byte_Defs.Byte_String (1 .. Data'Length);
        The_Count : Natural;
        Iosb : Vms.Iosb_Type;
        Cc : Vms.Cond_Value_Type;
    begin
        if not Is_Connected (Connection) then
            Status := Transport_Defs.Not_Connected;
            Count := 0;
        else
            Vms.Qiow (Func => Ip_Tcp_Defs.Vms_Function.Io_Receive,
                      Status => Cc,
                      Chan => Connection.Channel,
                      Iosb => Vms.Address (Iosb'Address),
                      P1 => To_Unsigned_Longword (Buffer'Address),
                      P2 => To_Byte_Count (Buffer'Size));
            Print ("IO_RECEIVE", Cc, Iosb);
            Cc := Vms.Cond_Value_Type (Iosb.Status);
            The_Count := Natural (Iosb.Count);
            Data (Data'First .. Data'First + The_Count - 1) :=
               Buffer (1 .. The_Count);
            Count := The_Count;

            if not Is_Ok (Cc) then
                Connection.Is_Connected := False;
                Status := Convert (Cc);
            elsif The_Count = 0 then
                Connection.Is_Connected := False;
                Status := Transport_Defs.Not_Connected;
            else
                Status := Transport_Defs.Ok;
            end if;
        end if;
    end Blocking_Receive;

    task body Transmitter_Type is
        Connection : Transport.Connection_Id;
        Buffer : Byte_Defs.Byte_String (1 .. 1024);
        Buflen : Natural := 0;
        Status : Transport_Defs.Status_Code;
        Count : Natural;
        Total : Natural;

        procedure Put_Data (Data : Byte_Defs.Byte_String;
                            Count : out Natural) is
        begin
            if Data'Length > Buffer'Length then
                Count := Buffer'Length;
                Buflen := Buffer'Length;
                Buffer := Data (Data'First .. Data'First + Buflen - 1);
            else
                Count := Data'Length;
                Buflen := Data'Length;
                Buffer (1 .. Buflen) := Data;
            end if;
        end Put_Data;

        pragma Inline (Put_Data);

    begin
        loop
            begin
                select
                    accept Connect (Connection : Transport.Connection_Id) do
                        Transmitter_Type.Connection := Connect.Connection;
                        Buflen := 0;
                    end Connect;
                or
                    accept Disconnect;
                or
                    when (Buflen = 0) =>
                        accept Transmit (Status : out
                                            Transport_Defs.Status_Code;
                                         Data : Byte_Defs.Byte_String;
                                         Count : out Natural) do
                            if Is_Connected (Connection) then
                                Status := Transport_Defs.Ok;
                                Put_Data (Data, Count);
                            else
                                Status := Transport_Defs.Not_Connected;
                                Count := 0;
                            end if;
                        end Transmit;

                end select;

                Total := 0;

                while Total < Buflen loop
                    Blocking_Transmit (Connection, Status,
                                       Buffer (Total + 1 .. Buflen), Count);
                    Total := Total + Count;
                    exit when not Is_Connected (Connection);
                end loop;

                Buflen := 0;
            exception
                when others =>
                    null;
            end;
        end loop;
    end Transmitter_Type;

    task body Receiver_Type is

        Connection : Transport.Connection_Id := null;
        Buffer : Byte_Defs.Byte_String (1 .. 1024);
        Buflen : Natural := 0;
        Status : Transport_Defs.Status_Code;

        procedure Get_Received_Data
                     (Data : out Byte_Defs.Byte_String; Count : out Natural) is
            Taken : Natural;
        begin
            if Data'Length > Buflen then
                Taken := Buflen;
                Buflen := 0;
                Data (Data'First .. Data'First + Taken - 1) :=
                   Buffer (1 .. Taken);
            else
                Taken := Data'Length;
                Buflen := Buflen - Taken;
                Data := Buffer (1 .. Taken);
                Buffer (1 .. Buflen) := Buffer (Taken + 1 .. Taken + Buflen);
            end if;

            Count := Taken;
        end Get_Received_Data;

        pragma Inline (Get_Received_Data);

    begin
        loop
            begin
                select
                    accept Connect (Connection : Transport.Connection_Id) do
                        Receiver_Type.Connection := Connect.Connection;
                        Buflen := 0;
                    end Connect;
                or
                    accept Disconnect;
                or
                    when (Buflen > 0) or else (not Is_Connected (Connection)) =>
                        accept Receive (Status : out Transport_Defs.Status_Code;
                                        Data : out Byte_Defs.Byte_String;
                                        Count : out Natural) do
                            if Buflen > 0 then
                                Status := Transport_Defs.Ok;
                                Get_Received_Data (Data, Count);
                            else
                                Status := Transport_Defs.Not_Connected;
                                Count := 0;
                            end if;
                        end Receive;
                end select;

                if Buflen = 0 and then Is_Connected (Connection) then
                    Blocking_Receive (Connection, Status, Buffer, Buflen);
                end if;
            exception
                when others =>
                    null;
            end;
        end loop;
    end Receiver_Type;

    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
    begin
        select
            Connection.Transmitter.Transmit (Status, Data, Count);
        or
            delay Max_Wait;
            Status := Transport_Defs.Timed_Out;
            Count := 0;
        end select;
    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
    begin
        select
            Connection.Receiver.Receive (Status, Data, Count);
        or
            delay Max_Wait;
            Status := Transport_Defs.Timed_Out;
            Count := 0;
        end select;
    end Receive;

    function Local_Host (Network : Transport_Defs.Network_Name)
                        return Transport_Defs.Host_Id is
    begin
        if Transport_Defs."="
              (Transport_Defs.Normalize (Network), "TCP/IP") then
            return Local_Host_Id;
        else
            return Transport_Defs.Null_Host_Id;
        end if;
    end Local_Host;

    procedure Init (Iter : in out Network_Name_Iterator) is
    begin
        Iter := 0;
    end Init;

    procedure Next (Iter : in out Network_Name_Iterator) is
    begin
        Iter := Iter + 1;
    end Next;

    function Done (Iter : Network_Name_Iterator) return Boolean is
    begin
        return Iter >= 1;
    end Done;

    function Value (Iter : Network_Name_Iterator)
                   return Transport_Defs.Network_Name is
    begin
        case Iter is
            when 0 =>
                return "TCP/IP";
            when others =>
                return "";
        end case;
    end Value;

    procedure Init (Iter : in out Connection_Id_Iterator) is
    begin
        Connection_Pool.Init (Iter);
    end Init;

    procedure Next (Iter : in out Connection_Id_Iterator) is
    begin
        Connection_Pool.Next (Iter);
    end Next;

    function Done (Iter : Connection_Id_Iterator) return Boolean is
    begin
        return Iter = null;
    end Done;

    function Value (Iter : Connection_Id_Iterator) return Connection_Id is
    begin
        return Connection_Id (Iter);
    end Value;

    function Network (Connection : Transport.Connection_Id)
                     return Transport_Defs.Network_Name is
    begin
        if Is_Open (Connection) then
            return "TCP/IP";
        else
            return "";
        end if;
    end Network;

    function Local_Host (Connection : Transport.Connection_Id)
                        return Transport_Defs.Host_Id is
    begin
        if Is_Open (Connection) then
            return Local_Host_Id;
        else
            return Transport_Defs.Null_Host_Id;
        end if;
    end Local_Host;

    function Local_Socket (Connection : Transport.Connection_Id)
                          return Transport_Defs.Socket_Id is
    begin
        if Is_Open (Connection) then
            return Convert (Connection.Local_Port);
        else
            return Transport_Defs.Null_Socket_Id;
        end if;
    end Local_Socket;

    function Remote_Host (Connection : Transport.Connection_Id)
                         return Transport_Defs.Host_Id is
    begin
        if Is_Open (Connection) then
            return Convert (Connection.Remote_Host);
        else
            return Transport_Defs.Null_Host_Id;
        end if;
    end Remote_Host;

    function Remote_Socket (Connection : Transport.Connection_Id)
                           return Transport_Defs.Socket_Id is
    begin
        if Is_Open (Connection) then
            return Convert (Connection.Remote_Port);
        else
            return Transport_Defs.Null_Socket_Id;
        end if;
    end Remote_Socket;

    function Hash (Connection : Transport.Connection_Id) return Natural is
    begin
        if Is_Open (Connection) then
            return Transport_Defs.Hash (Convert (Connection.Local_Port));
        else
            return 0;
        end if;
    end Hash;

end Transport;