DataMuseum.dk

top - download

    Length: 6180 (0x1824)
    Types: TextFile
    Names: »B«

└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS 
    └─ ⟦91c658230⟧ »DATA« 
        └─⟦458657fb6⟧ 
            └─⟦a5bbbb819⟧ 
                └─⟦this⟧ 
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
    └─ ⟦fc9b38f02⟧ »DATA« 
        └─⟦9b46a407a⟧ 
            └─⟦eec0a994f⟧ 
                └─⟦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 Rpc.Overlaps (Server_Versions, Supported_Versions) then  
            Transport_Stream.Set_User_Id  
               (Stream, Integer (Rpc.Max (Server_Versions,  
                                          Supported_Versions)));  
        else  
            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));  
        if Rpc.Version_Number (Transport_Stream.Get_User_Id (The_Stream)) in  
           Rpc.Username_Versions.First .. Rpc.Username_Versions.Last then  
            Transport_Interchange.Put_String (The_Stream, Username);  
            Transport_Interchange.Put_String (The_Stream, Password);  
        end if;  
    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_With_Username  
                 (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;  
                  Username : String := Default_Username;  
                  Password : String := Default_Password) is  
    begin  
        Start_Request  
           (Stream, Proc, Network, Host, Socket, Program, Version,  
            Username, Password);  
    end Start_Request_With_Username;

    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;