DataMuseum.dk

top - download

    Length: 4842 (0x12ea)
    Types: TextFile
    Names: »B«

└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
    └─ ⟦bb34fe6e2⟧ »DATA« 
        └─⟦15d8b76c6⟧ 
            └─⟦this⟧ 

TextFile

with Transport_Interchange;
with Transport_Stream;

package body Rpc_Client is

    Supported_Versions : constant Rpc.Version_Range := (3, 5);

    procedure Exchange_Versions (Stream : Transport_Stream.Stream_Id) is
        Server_Versions : Rpc.Version_Range;
    begin
        Rpc.Put (Stream, Supported_Versions);
        Transport_Stream.Flush_Transmit_Buffer (Stream);
        Rpc.Get (Stream, Server_Versions);

        if not Rpc.Overlaps (Server_Versions, Supported_Versions) then
            Transport_Stream.Disconnect (Stream);
            raise Rpc.No_Such_Version;
        end if;
    end Exchange_Versions;

    procedure Start_Request (The_Stream : Transport_Stream.Stream_Id;
                             Is_New : Boolean;
                             Proc : Rpc.Procedure_Number;
                             Program : Rpc.Program_Number;
                             Version : Rpc.Version_Number;
                             Username : String;
                             Password : String) is
    begin
        if Is_New then
            Exchange_Versions (The_Stream);
        end if;
        Rpc.Put_Message (The_Stream,
                         (Rpc.Call_Message, 0, Program, Version, Proc));
        Transport_Interchange.Put_String (The_Stream, Username);
        Transport_Interchange.Put_String (The_Stream, Password);
    end Start_Request;

    procedure Start_Request (Stream : out Transport_Stream.Stream_Id;
                             Proc : Rpc.Procedure_Number;
                             Network : Transport_Defs.Network_Name;
                             Host : Transport_Defs.Host_Id;
                             Socket : Transport_Defs.Socket_Id;
                             Program : Rpc.Program_Number;
                             Version : Rpc.Version_Number;
                             Username : String;
                             Password : String) is
        The_Stream : Transport_Stream.Stream_Id;
        Is_New : Boolean;
    begin
        Transport_Stream.Allocate (The_Stream, Is_New, Network, Host, Socket);
        Start_Request (The_Stream, Is_New, Proc, Program,
                       Version, Username, Password);
        Stream := The_Stream;
    end Start_Request;

    procedure Start_Request_Generic
                 (Stream : out Transport_Stream.Stream_Id;
                  Proc : Rpc.Procedure_Number;
                  Network : Transport_Defs.Network_Name := Default_Network;
                  Host : Transport_Defs.Host_Id := Default_Host;
                  Socket : Transport_Defs.Socket_Id := Default_Socket;
                  Program : Rpc.Program_Number := Default_Program;
                  Version : Rpc.Version_Number := Default_Version) is
    begin
        Start_Request (Stream, Proc, Network, Host, Socket, Program, Version,
                       Username => "",
                       Password => "");
    end Start_Request_Generic;

    procedure Begin_Request_Generic (Stream : out Transport_Stream.Stream_Id;
                                     Proc : Rpc.Procedure_Number) is
        The_Stream : Transport_Stream.Stream_Id;
        Is_New : Boolean;
    begin
        Transport_Stream.Allocate (The_Stream, Pool, Is_New);
        Start_Request (The_Stream, Is_New, Proc, Program, Version,
                       Username => "",
                       Password => "");
        Stream := The_Stream;
    end Begin_Request_Generic;

    procedure End_Request_With_Exception
                 (Stream : Transport_Stream.Stream_Id) is
        Response : Rpc.Message_Header;
        Excep : Rpc.Exception_Number;
    begin
        Transport_Stream.Flush_Transmit_Buffer (Stream);
        Response := Rpc.Get_Message (Stream);

        if Rpc."/=" (Response.Kind, Rpc.Return_Message) then
            Transport_Stream.Disconnect (Stream);
            raise Rpc.Protocol_Error;
        end if;
    exception
        when Rpc.Server_Defined_Error =>
            Rpc.Get (Stream, Excep);
            End_Response (Stream);
            Raise_Exception (Excep);
            raise; -- in case Raise_Exception didn't.
        when others =>
            End_Response (Stream);
            raise;
    end End_Request_With_Exception;

    procedure Raise_Unknown_Exception (Excep : Rpc.Exception_Number) is
    begin
        raise Rpc.Server_Defined_Error; -- JMK 10/24/86 redundant, but why not.
    end Raise_Unknown_Exception;

    procedure End_Request_Guts is
       new End_Request_With_Exception
              (Raise_Exception => Raise_Unknown_Exception);

    procedure End_Request (Stream : Transport_Stream.Stream_Id) is
    begin
        End_Request_Guts (Stream);
    end End_Request;

    procedure End_Response (Stream : Transport_Stream.Stream_Id) is
    begin
        Transport_Stream.Deallocate (Stream);
    end End_Response;

end Rpc_Client;