⟦e0b000d8b⟧

E3 Source Code



with Interchange;
with Transport_Stream;

package Rpc is

    pragma Subsystem (Network, Private_Part => Closed);
    pragma Module_Name (4, 2517);

    type Version_Number is new Interchange.Short_Integer;

    type Version_Range is
        record
            First, Last : Version_Number;
        end record;

    type Transaction_Id is new Interchange.Short_Integer;

    type Program_Number is new Interchange.Integer;

    type Procedure_Number is new Interchange.Short_Integer;


    type Error_Type is (Error_Other, Error_Constraint, Error_Numeric,
                        Error_Program, Error_Storage, Error_Tasking,
                        Status_Error, Mode_Error, Name_Error, Use_Error,
                        Device_Error, End_Error, Data_Error, Layout_Error,
                        Error_Server_Defined, Error_Username_Or_Password);

    -- for Error_Type use
    --     (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15);


    type Reject_Kind is (Rej_No_Such_Program, Rej_No_Such_Version,
                         Rej_No_Such_Procedure, Rej_Invalid_Argument);

    -- for Reject_Kind use (0, 1, 2, 3);


    type Reject_Details (Kind : Reject_Kind := Rej_Invalid_Argument) is
        record
            case Kind is
                when Rej_No_Such_Version =>
                    Supported : Version_Range;
                when others =>
                    null;
            end case;
        end record;


    type Message_Kind is (Call_Message, Reject_Message,
                          Return_Message, Abort_Message);

    -- for Message_Kind use (0, 1, 2, 3);


    type Message_Header (Kind : Message_Kind := Return_Message) is
        record
            Id : Transaction_Id := 0;
            case Kind is
                when Call_Message =>
                    Program : Program_Number;
                    Version : Version_Number;
                    Proc    : Procedure_Number;
                    -- argument values follow
                when Reject_Message =>
                    Details : Reject_Details;
                when Return_Message =>
                    null;
                    -- result values follow
                when Abort_Message =>
                    Error : Error_Type;
            end case;
        end record;


    -- Interchange operations on the above types:

    subtype Stream_Id is Transport_Stream.Stream_Id;

    procedure Put (Into : Stream_Id; Data : Version_Range);
    procedure Get (From : Stream_Id; Data : out Version_Range);

    procedure Put_Message (Into : Stream_Id; Data : Message_Header);
    function  Get_Message (From : Stream_Id) return Message_Header;

    -- This last procedure is a little unusual.  If the gotten value
    -- is OK, it returns it, otherwise it raises the corresponding
    -- exception.  In a sense, an exception (or lack thereof) is a
    -- possible return value.

    Protocol_Error       : exception;
    No_Such_Program      : exception;
    No_Such_Version      : exception;
    No_Such_Procedure    : exception;
    Other_Error          : exception;
    Invalid_Argument     : exception;
    Server_Defined_Error : exception;


    type Exception_Number is new Interchange.Integer;

    procedure Put (Into : Stream_Id; Data : Exception_Number);
    procedure Get (From : Stream_Id; Data : out Exception_Number);


    function Overlaps (X, Y : Version_Range) return Boolean;
    -- Return true if X and Y have some versions in common.

    function Max (X, Y : Version_Range) return Version_Number;
    -- Return the largest version which is common to both X & Y.

    Defined_Versions : constant Version_Range := (3, 5);
    -- RPC protocol versions which have been defined.

    Exception_Versions : constant Version_Range := (4, Version_Number'Last);
    -- RPC protocol versions which support server-defined exceptions.
    Username_Versions : constant Version_Range := (5, Version_Number'Last);
    -- RPC protocol versions which support passing Username & Password
    -- information with each call.

    Username_Or_Password_Error : exception;
    -- The Username & Password supplied with a remote procedure call
    -- were rejected by the server machine, either because there is
    -- no such Username or because the Password is incorrect.

end Rpc;
DataMuseum.dk

Rational R1000/400

⟦e0b000d8b⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
