DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦6fa6f0756⟧ Ada Source

    Length: 10240 (0x2800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Configuration_Testing, seg_002fe1

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Byte_Defs;
with Byte_String_Io;
with Log;
with Profile;
with Transport;
with Transport_Defs;
with Transport_Name;
--
-- The primary source for this package is maintained in
--  !!CLEM!TOOLS.NETWORKING.DEBUG
--
package body Configuration_Testing is

    Digit : array (Byte_Defs.Byte range 0 .. 15) of Character :=
       ('0', '1', '2', '3', '4', '5', '6', '7',
        '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

    Failed : exception;

    function "=" (Left, Right : Transport_Defs.Status_Code) return Boolean
        renames Transport_Defs."=";
    function "=" (Left, Right : Byte_Defs.Byte_String) return Boolean
        renames Byte_Defs."=";
    function "+" (Left, Right : Byte_Defs.Byte) return Byte_Defs.Byte
        renames Byte_Defs."+";
    function "*" (Left, Right : Byte_Defs.Byte) return Byte_Defs.Byte
        renames Byte_Defs."*";
    function "/" (Left, Right : Byte_Defs.Byte) return Byte_Defs.Byte
        renames Byte_Defs."/";
    function "mod" (Left, Right : Byte_Defs.Byte) return Byte_Defs.Byte
        renames Byte_Defs."mod";

    procedure Check (Status : Transport_Defs.Status_Code; From : String) is
    begin
        if Status /= Transport_Defs.Ok then
            Log.Put_Line ("Transport." & From & ".Status = " &
                          Transport_Defs.Image (Status), Profile.Error_Msg);
            raise Failed;
        end if;
    end Check;

    function Max (Left, Right : Integer) return Integer is
    begin
        if Left > Right then
            return Left;
        else
            return Right;
        end if;
    end Max;

    function Hex_Image (A : Transport_Defs.Host_Id) return String is
        S : String (1 .. 17) := "xx-xx-xx-xx-xx-xx";
        Radix : constant := 16;
    begin
        for I in 0 .. Natural (A'Length) - 1 loop
            S (S'First + (I * 3)) := Digit (A (A'First + I) / Radix);
            S (S'First + (I * 3) + 1) := Digit (A (A'First + I) mod Radix);
        end loop;
        return S (1 .. (A'Length * 3) - 1);
    end Hex_Image;

    procedure Client (Server : String := "FF-FF-FF-FF-FF-FF";
                      Receipt : Byte_Defs.Byte_String := (0, 0);
                      Local : Transport_Defs.Host_Id :=
                         Transport.Local_Host (Configuration_Testing.Network);
                      Network : Transport_Defs.Network_Name :=
                         Configuration_Testing.Network;
                      Socket : Transport_Defs.Socket_Id :=
                         Configuration_Testing.Socket;
                      Max_Wait : Duration := 5.0) is
        Remote : constant Transport_Defs.Host_Id :=
           Transport_Name.Host_To_Host_Id (Server);
        Connection : Transport.Connection_Id;
        Status : Transport_Defs.Status_Code;
        Data : Byte_Defs.Byte_String (1 .. Max (48, 12 + Receipt'Length));
        Count : Natural;
        Skip : Natural;
        Opcode : Natural;
        Received : Natural := 0;
    begin
        Data (1 .. 2) := (0, 0); -- skip count
        Data (3 .. 4) := (2, 0); -- opcode
        Data (5 .. 10) := Byte_Defs.Byte_String (Local);
        Data (11 .. 12) := (1, 0); -- next opcode
        Data (13 .. 12 + Receipt'Length) := Receipt;
        for Di in 13 + Receipt'Length .. Data'Last loop
            Data (Di) := 0;
        end loop;
        Transport.Open (Connection, Status, Network, Socket);
        Check (Status, "Open");
        Transport.Connect (Connection, Status,
                           Remote_Host => Remote,
                           Remote_Socket => Socket);
        Check (Status, "Connect(Active)");
        Transport.Transmit (Connection, Status, Data, Count);
        Check (Status, "Transmit");
        if Count < Data'Length then
            Log.Put_Line ("only" & Natural'Image (Count) &
                          " out of" & Natural'Image (Data'Length) &
                          " bytes were transmitted.", Profile.Warning_Msg);
        end if;
        loop
            Transport.Receive (Connection, Status, Data, Count,
                               Max_Wait => Max_Wait);
            exit when Status = Transport_Defs.Timed_Out and then Received > 0;
            Check (Status, "Receive");
            if Count >= 14 and then  
               Data (1 .. 2) = (8, 0) and then  
               Data (3 .. 4) = (2, 0) and then
               Data (5 .. 10) = Byte_Defs.Byte_String (Local) and then
               Data (11 .. 12) = (1, 0) and then
               Data (13 .. 12 + Receipt'Length) = Receipt then
                Log.Put_Line ("from " &
                              Hex_Image (Transport.Remote_Host (Connection)));
                if Count < Data'Length then
                    Log.Put_Line ("only" & Natural'Image (Count) &
                                  " bytes were received.", Profile.Warning_Msg);
                end if;
                Received := Received + 1;
            else
                Log.Put_Line ("from " &
                              Hex_Image (Transport.Remote_Host (Connection)) &
                              ": " & Byte_String_Io.Image (Data (1 .. Count)),
                              Profile.Error_Msg);
            end if;
        end loop;
        Transport.Close (Connection);
        Log.Put_Line ("received" & Natural'Image (Received) & " responses.",
                      Profile.Positive_Msg);
    exception
        when Failed =>
            Log.Put_Line ("Client failed", Profile.Negative_Msg);
            Transport.Close (Connection);
    end Client;

    procedure Server (Network : Transport_Defs.Network_Name :=
                         Configuration_Testing.Network;
                      Socket : Transport_Defs.Socket_Id :=
                         Configuration_Testing.Socket) is
        Connection : Transport.Connection_Id;
        Status : Transport_Defs.Status_Code;
        Data : Byte_Defs.Byte_String (1 .. 1500);
        Count : Natural;
        Skip : Natural;
        Opcode : Natural;
        Radix : constant := 256;
    begin
        Transport.Open (Connection, Status, Network, Socket);
        Check (Status, "Open");
        Transport.Connect (Connection, Status);
        Check (Status, "Connect(Passive)");
        loop
            Transport.Receive (Connection, Status, Data, Count);
            Check (Status, "Receive");
            if Count >= 2 then
                Skip := Natural (Data (1)) + (Radix * Natural (Data (2)));
                if Count >= Skip + 4 then
                    Opcode := Natural (Data (Skip + 3)) +
                                 (Radix * Natural (Data (Skip + 4)));
                    case Opcode is
                        when 1 => -- Reply
                            null;
                        when 2 => -- Forward Data
                            Transport.Connect
                               (Connection, Status,
                                Remote_Host =>
                                   Transport_Defs.Host_Id
                                      (Data (Skip + 5 .. Skip + 10)),
                                Remote_Socket => Socket);
                            Check (Status, "Connect(Active)");
                            Data (1 .. 2) :=
                               (Byte_Defs.Byte ((Skip + 8) mod Radix),
                                Byte_Defs.Byte ((Skip + 8) / Radix));
                            Transport.Transmit (Connection, Status,
                                                Data (1 .. Count), Count);
                            Check (Status, "Transmit");
                        when others =>
                            null;
                    end case;
                end if;
            end if;
        end loop;
        Transport.Close (Connection);
    exception
        when Failed =>
            Log.Put_Line ("Server failed", Profile.Negative_Msg);
            Transport.Close (Connection);
    end Server;

end Configuration_Testing;

E3 Meta Data

    nblk1=9
    nid=0
    hdr6=12
        [0x00] rec0=1e rec1=00 rec2=01 rec3=03c
        [0x01] rec0=1c rec1=00 rec2=02 rec3=06a
        [0x02] rec0=15 rec1=00 rec2=03 rec3=006
        [0x03] rec0=16 rec1=00 rec2=04 rec3=00e
        [0x04] rec0=12 rec1=00 rec2=05 rec3=026
        [0x05] rec0=17 rec1=00 rec2=06 rec3=022
        [0x06] rec0=17 rec1=00 rec2=07 rec3=044
        [0x07] rec0=15 rec1=00 rec2=08 rec3=01a
        [0x08] rec0=06 rec1=00 rec2=09 rec3=000
    tail 0x20f0013b6000806b6e1c5 0x42a00088462060003