DataMuseum.dk

top - metrics - download

    Length: 5655 (0x1617)
    Types: TextFile
    Names: »RPC_SERVER_BODY«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Io_Exceptions;
with Interchange;

package body Rpc_Server is

    Supported_Versions : constant Rpc.Version_Range := (4, 4);

    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) :=
           (Rpc.Abort_Message, Id, Rpc.Error_Server_Defined);
    begin
        Rpc.Put_Message (Stream, Response);
        Rpc.Put (Stream, Excep);
    end Return_Exception;

    procedure Serve (Connection : Transport.Connection_Id) is

        Stream : Transport_Stream.Stream_Id;
        Rpc_Version : Rpc.Version_Range;
        Request : Rpc.Message_Header;
        use Rpc;

        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;

        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
        Transport_Stream.Allocate (Stream, Connection);

        begin
            Rpc.Get (Stream, Rpc_Version);
            Rpc.Put (Stream, Supported_Versions);

            if Rpc.Overlaps (Rpc_Version, Supported_Versions) then
                begin
                    loop
                        Transport_Stream.Flush_Transmit_Buffer (Stream);
                        Request := 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
                            begin
                                Process_Call (Stream, Request.Id,
                                              Request.Version, Request.Proc);
                            exception
                                when Interchange.Constraint_Error =>
                                    raise 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 others =>
                                    Put_Abort (Rpc.Error_Other);
                            end;
                        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;
            end if;

            Transport_Stream.Flush_Transmit_Buffer (Stream);
        exception
            when others =>
                null;
        end;

        Transport_Stream.Deallocate (Stream);
    end Serve;

end Rpc_Server;