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

⟦60301c9c0⟧ TextFile

    Length: 3736 (0xe98)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Behavior_Defs;
with Identifier;
with Message;
with Message_Transport;
with Method;
with Parameter;
with Signature;

with Text_Io;


use Text_Io;
use Message_Transport;
package body Service is

    Not_Registered : exception;

    Id : Identifier.Object;


    procedure Register_Service (Host : String;
                                Socket : Message_Transport.Socket) is
        Status : Message_Transport.Status_Code;
    begin  
        Put_Line ("register_service: host => " & Host & " socket => " &
                  Message_Transport.Socket'Image (Socket));

        Message_Transport.Put
           (Message => Standard.Message.Image
                          (Message.Create
                              (Class => Message.Registration,
                               Addressee => Identifier.Hash (Identifier.Broker),
                               Sender => Identifier.Hash (Identifier.Nil),
                               Method => "registration",
                               Parameter1_Name => "host",
                               Parameter1_Class => "string",
                               Parameter1_Value => Host,
                               Parameter2_Name => "socket",
                               Parameter2_Class => "string",
                               Parameter2_Value =>
                                  Message_Transport.Socket'Image (Socket))),
            Remote_Host => "belladone",
            Remote_Socket => Message_Transport.Socket (2605),
            Number_Of_Retry => 10,
            Retry_Delay => 0.1,
            Status => Status);

        if Status /= Message_Transport.Ok then
            raise Not_Registered;
        end if;

    end Register_Service;

    function Identified (M : String) return Boolean is
        Mes : Message.Object;
        Met : Method.Object;
        Sig : Signature.Object;
        Par : Parameter.Object;  
        Iter : Signature.Iterator;
    begin
        Mes := Message.Value (M);

        if not Message."=" (Message.Get_Class (Mes), Message.Notification) then
            return False;
        end if;


        Met := Message.Get_Method (Mes);

        if Method.Get_Name (Met) /= Behavior_Defs.Identification_Name then
            return False;
        end if;


        Sig := Method.Get_Signature (Met);

        Signature.Init (Iter, Sig);

        if Signature.Is_Done (Iter) then
            return False;
        end if;


        Par := Signature.Value (Iter);

        if Parameter.Get_Name (Par) /=
           Behavior_Defs.Identification_Parameter then
            return False;
        end if;

        if Parameter.Get_Class (Par) /= Behavior_Defs.Identification_Class then
            return False;
        end if;

        declare
        begin
            Id := Identifier.Value (Natural'Value (Parameter.Get_Value (Par)));
        exception
            when others =>
                return False;
        end;

        return True;

    end Identified;


    procedure Process_Message (M : String) is
    begin
        Put_Line ("Process_Message: " & M);
        Process_Message (Message.Value (M));
    end Process_Message;


    procedure Transport_Start is new Message_Transport.Start_Server
                                        (Register_Service => Register_Service,
                                         Service_Identified => Identified,
                                         Ready_To_Receive => Ready_To_Receive,
                                         Receive_Callback => Process_Message);


    procedure Start is
    begin
        Transport_Start (Local_Socket => 2606,
                         Buffer_Size => 1024,
                         Wait_For_Identification => True);
    end Start;

end Service;