DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦a57ec5e4c⟧ TextFile

    Length: 7914 (0x1eea)
    Types: TextFile
    Names: »B«

Derivation

└─⟦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 Io_Exceptions;  
with Interchange;  
with Transport_Interchange;

package body Rpc_Server is

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

    procedure Begin_Response (Stream : Transport_Stream.Stream_Id;  
                              Id : Rpc.Transaction_Id) is  
        Response : Rpc.Message_Header (Kind => Rpc.Return_Message) :=  
           (Rpc.Return_Message, Id);  
    begin  
        Rpc.Put_Message (Stream, Response);  
    end Begin_Response;

    procedure Return_Exception (Stream : Transport_Stream.Stream_Id;  
                                Id : Rpc.Transaction_Id;  
                                Excep : Rpc.Exception_Number) is  
        Response : Rpc.Message_Header (Kind => Rpc.Abort_Message);  
    begin  
        if Rpc.Version_Number (Transport_Stream.Get_User_Id (Stream)) in  
           Rpc.Exception_Versions.First .. Rpc.Exception_Versions.Last then  
            Response := (Rpc.Abort_Message, Id, Rpc.Error_Server_Defined);  
            Rpc.Put_Message (Stream, Response);  
            Rpc.Put (Stream, Excep);  
        else  
            Response := (Rpc.Abort_Message, Id, Rpc.Error_Other);  
            Rpc.Put_Message (Stream, Response);  
        end if;  
    end Return_Exception;

    procedure Serve_With_Username (Connection : Transport.Connection_Id) is

        Stream : Transport_Stream.Stream_Id;  
        Client_Versions : Rpc.Version_Range;  
        Max_Version : Rpc.Version_Number;

        procedure Process_Calls is

            Request : Rpc.Message_Header;

            function "=" (X, Y : Rpc.Message_Kind) return Boolean  
                renames Rpc."=";  
            function "=" (X, Y : Rpc.Program_Number) return Boolean  
                renames Rpc."=";

            procedure Do_Process_Call is  
                procedure Put_Abort (Error : Rpc.Error_Type) is  
                begin  
                    Rpc.Put_Message (Stream,  
                                     (Kind => Rpc.Abort_Message,  
                                      Id => Request.Id,  
                                      Error => Error));  
                end Put_Abort;  
            begin  
                if Max_Version in  
                   Rpc.Username_Versions.First ..  
                      Rpc.Username_Versions.Last then  
                    declare  
                        Username : constant String :=  
                           Transport_Interchange.Get_String (Stream);  
                        Password : constant String :=  
                           Transport_Interchange.Get_String (Stream);  
                    begin  
                        Process_Call (Stream,  
                                      Request.Id, Request.Version, Request.Proc,  
                                      Username, Password);  
                    end;  
                else  
                    Process_Call (Stream,  
                                  Request.Id, Request.Version, Request.Proc,  
                                  Username => "",  
                                  Password => "");  
                end if;  
            exception  
                when Interchange.Constraint_Error =>  
                    raise Rpc.Invalid_Argument;  
                when Standard.Constraint_Error =>  
                    Put_Abort (Rpc.Error_Constraint);  
                when Standard.Numeric_Error =>  
                    Put_Abort (Rpc.Error_Numeric);  
                when Standard.Program_Error =>  
                    Put_Abort (Rpc.Error_Program);  
                when Standard.Storage_Error =>  
                    Put_Abort (Rpc.Error_Storage);  
                when Standard.Tasking_Error =>  
                    Put_Abort (Rpc.Error_Tasking);  
                when Io_Exceptions.Status_Error =>  
                    Put_Abort (Rpc.Status_Error);  
                when Io_Exceptions.Mode_Error =>  
                    Put_Abort (Rpc.Mode_Error);  
                when Io_Exceptions.Name_Error =>  
                    Put_Abort (Rpc.Name_Error);  
                when Io_Exceptions.Use_Error =>  
                    Put_Abort (Rpc.Use_Error);  
                when Io_Exceptions.Device_Error =>  
                    Put_Abort (Rpc.Device_Error);  
                when Io_Exceptions.End_Error =>  
                    Put_Abort (Rpc.End_Error);  
                when Io_Exceptions.Data_Error =>  
                    Put_Abort (Rpc.Data_Error);  
                when Io_Exceptions.Layout_Error =>  
                    Put_Abort (Rpc.Layout_Error);  
                when Rpc.Username_Or_Password_Error =>  
                    Put_Abort (Rpc.Error_Username_Or_Password);  
                when others =>  
                    Put_Abort (Rpc.Error_Other);  
            end Do_Process_Call;

            procedure Put_Reject (Details : Rpc.Reject_Details) is  
            begin  
                Rpc.Put_Message (Stream,  
                                 (Kind => Rpc.Reject_Message,  
                                  Id => Request.Id,  
                                  Details => Details));  
            end Put_Reject;

        begin  
            loop  
                Transport_Stream.Flush_Transmit_Buffer (Stream);  
                Request := Rpc.Get_Message (Stream);  
                if Request.Kind /= Rpc.Call_Message then  
                    raise Rpc.Protocol_Error;  
                elsif Request.Program /= Program then  
                    raise Rpc.No_Such_Program;  
                elsif not (Request.Version in  
                           Supported.First .. Supported.Last) then  
                    raise Rpc.No_Such_Version;  
                else  
                    Do_Process_Call;  
                end if;  
            end loop;  
        exception  
            when Rpc.No_Such_Program =>  
                Put_Reject ((Kind => Rpc.Rej_No_Such_Program));  
            when Rpc.No_Such_Version =>  
                Put_Reject ((Kind => Rpc.Rej_No_Such_Version,  
                             Supported => Supported));  
            when Rpc.No_Such_Procedure =>  
                Put_Reject ((Kind => Rpc.Rej_No_Such_Procedure));  
            when Rpc.Invalid_Argument =>  
                Put_Reject ((Kind => Rpc.Rej_Invalid_Argument));  
            when others =>  
                null;  
        end Process_Calls;

    begin  
        Transport_Stream.Allocate (Stream, Connection);  
        begin  
            Rpc.Get (Stream, Client_Versions);  
            Rpc.Put (Stream, Supported_Versions);  
            if Rpc.Overlaps (Client_Versions, Supported_Versions) then  
                Max_Version := Rpc.Max (Client_Versions, Supported_Versions);  
                Transport_Stream.Set_User_Id -- JMK 10/24/86 for future use.
                   (Stream, Integer (Max_Version));  
                Process_Calls;  
            end if;  
            Transport_Stream.Flush_Transmit_Buffer (Stream);  
        exception  
            when others =>  
                null;  
        end;  
        Transport_Stream.Deallocate (Stream);  
    end Serve_With_Username;

    procedure Serve (Connection : Transport.Connection_Id) is

        procedure Ignore_Username (Stream : Transport_Stream.Stream_Id;  
                                   Id : Rpc.Transaction_Id;  
                                   Version : Rpc.Version_Number;  
                                   Proc : Rpc.Procedure_Number;  
                                   Username : String;  
                                   Password : String) is  
        begin  
            Process_Call (Stream, Id, Version, Proc);  
        end Ignore_Username;

        procedure Guts is new Serve_With_Username  
                                 (Program, Supported, Ignore_Username);

    begin  
        Guts (Connection);  
    end Serve;

end Rpc_Server;