|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 22528 (0x5800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Agent, seg_057482
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Queue_Generic;
with Transport;
package body Generic_Agent is
package Queue_Mail is new Queue_Generic (Element => Frame_Defs.Frame);
The_Connection : Orb_Defs.Connection_Id;
-- The connection used to send a mail to the ORB
The_Success : Boolean;
-- Variable to detect error during mail sending
The_Agent_Socket : Orb_Defs.Socket_Id := Orb_Defs.Null_Socket_Id;
-- The socket during the mail sending
Registrated : Boolean := False;
--
-- les taches de ce package
--
task Dispatcher is
entry Dispose;
end Dispatcher;
task Agent_As_A_Server is
entry Dispose;
entry Give_Request (The_Request : Frame_Defs.Frame);
end Agent_As_A_Server;
task Agent_As_A_Customer is
entry Dispose;
entry Give_Job_Answer (The_Answer : Frame_Defs.Frame);
entry Is_There_An_Answer (The_Success : out Boolean);
entry Take_Job_Answer (The_Answer : out Frame_Defs.Frame);
end Agent_As_A_Customer;
procedure Convert (To_Be_Converted : Frame_Defs.Frame;
Converted : out Frame_Defs.Communication_Data) is
begin
Frame_Defs.Get_Frame (To_Be_Converted, Converted);
end Convert;
package Agent_Mailer is new Mail_Sender (Frame_Defs.Frame, Convert);
--
-- procedures et fonctions internes
--
procedure Init is
begin
Text_Io.Put_Line ("Generic_Agent is going to initiate its letter box.");
Letter_Box_Frames.Init;
-- Init of the agent's letter box object
Text_Io.Put_Line ("Generic_Agent is going to initiate its connector.");
Connector_Frames.Init (The_Agent_Socket);
-- Init of the agent's connector object
Agent_Mailer.Init (The_Connection, Orb_Defs.Network_Kind,
The_Agent_Socket);
-- Init of the agent's variables used to send mail
end Init;
procedure Send_Mail_To_Orb (The_Time_Out : Natural;
Success : out Boolean;
The_Mail_To_Send : Frame_Defs.Frame) is
begin
Text_Io.Put_Line ("Agent is going to send :");
Text_Io.Put_Line (Frame_Defs.Image (The_Mail_To_Send));
Agent_Mailer.Send_Mail
(The_Connection => The_Connection,
The_Remote_Host => (193, 54, 146, 132),
The_Remote_Socket => Orb_Defs.Default_Orb_Socket,
The_Time_Out => The_Time_Out,
Success => Success,
The_Mail_To_Send => The_Mail_To_Send);
Text_Io.Put_Line ("Going out of send_mail_to_orb");
end Send_Mail_To_Orb;
procedure Dispatch (The_Mail : Frame_Defs.Frame) is
The_Service_Kind : Orb_Defs.Class;
The_Service : Orb_Defs.Funct;
begin
Frame_Defs.Get (The_String_Field => Frame_Defs.Service_Kind_Field,
The_Frame => The_Mail,
The_Str => The_Service_Kind);
Frame_Defs.Get (The_String_Field => Frame_Defs.Service_Field,
The_Frame => The_Mail,
The_Str => The_Service);
-- trier les retours de job et les autres requetes (check ou demandes de job a l'agent)
Text_Io.Put_Line ("DISPATCHER working on " &
The_Service_Kind & " " & The_Service);
if The_Service_Kind = "rjob" then
Agent_As_A_Customer.Give_Job_Answer (The_Mail);
elsif The_Service_Kind = "regi" then
if The_Service = "ok " then
Registrated := True;
end if;
elsif The_Service_Kind = "unre" then
if The_Service = "ok " then
Registrated := False;
end if;
elsif The_Service_Kind /= "chck" then
Agent_As_A_Server.Give_Request (The_Mail);
end if;
end Dispatch;
procedure Reverse_Adresses (The_Frame : in out Frame_Defs.Frame) is
Dest_Ad, Exp_Ad : Orb_Defs.Host_Id;
Dest_Socket, Exp_Socket : Orb_Defs.Socket_Id;
begin
Frame_Defs.Get (Frame_Defs.Exp_Host_Field, The_Frame, Exp_Ad);
Frame_Defs.Get (Frame_Defs.Dest_Host_Field, The_Frame, Dest_Ad);
Frame_Defs.Set (Frame_Defs.Exp_Host_Field, Dest_Ad, The_Frame);
Frame_Defs.Set (Frame_Defs.Dest_Host_Field, Exp_Ad, The_Frame);
Frame_Defs.Get (Frame_Defs.Exp_Socket_Field, The_Frame, Exp_Socket);
Frame_Defs.Get (Frame_Defs.Dest_Socket_Field, The_Frame, Dest_Socket);
Frame_Defs.Set (Frame_Defs.Exp_Socket_Field, Dest_Socket, The_Frame);
Frame_Defs.Set (Frame_Defs.Dest_Socket_Field, Exp_Socket, The_Frame);
end Reverse_Adresses;
task body Dispatcher is
Done : Boolean := False;
The_Mail : Frame_Defs.Frame;
begin
-- init of the objects used by this agent
Init;
loop
select
accept Dispose do
Done := True;
end Dispose;
else
if Letter_Box_Frames.Check = True then -- is there a letter ?
Letter_Box_Frames.Read (The_Mail); -- if so then read it
Dispatch (The_Mail); -- and dispatch it
end if;
exit when Done = True;
end select;
end loop;
end Dispatcher;
task body Agent_As_A_Customer is
The_Answers_Fifo : Queue_Mail.Queue;
Done : Boolean := False;
begin
loop
select
accept Give_Job_Answer (The_Answer : Frame_Defs.Frame) do
Queue_Mail.Add (The_Answers_Fifo, The_Answer);
Text_Io.Put_Line ("Job answer added to the answer fifo.");
end Give_Job_Answer;
or
accept Take_Job_Answer (The_Answer : out Frame_Defs.Frame) do
The_Answer := Queue_Mail.First (The_Answers_Fifo);
Queue_Mail.Delete (The_Answers_Fifo);
Text_Io.Put_Line ("Job answer extracted from the fifo.");
end Take_Job_Answer;
or
accept Is_There_An_Answer (The_Success : out Boolean) do
The_Success := not Queue_Mail.Is_Empty (The_Answers_Fifo);
end Is_There_An_Answer;
or
accept Dispose do
Done := True;
end Dispose;
end select;
delay (3.0);
Text_Io.Put_Line ("Agent as a customer is alive.");
exit when Done = True;
end loop;
end Agent_As_A_Customer;
task body Agent_As_A_Server is
The_Requests_Fifo : Queue_Mail.Queue;
Done : Boolean := False;
begin
loop
select
accept Give_Request (The_Request : Frame_Defs.Frame) do
Queue_Mail.Add (The_Requests_Fifo, The_Request);
Text_Io.Put_Line ("Request added to the request fifo.");
end Give_Request;
or
accept Dispose do
Done := True;
end Dispose;
else
-- faire bosser le Treat ici.
if not Queue_Mail.Is_Empty (The_Requests_Fifo) then
declare
The_Frame : Frame_Defs.Frame;
The_Service_Kind : Orb_Defs.Class;
The_Service : Orb_Defs.Funct;
Treat_Result : V_String.Variable_String;
The_Success : Boolean;
begin
-- recuperer la frame et extraire les champs specifiant le job demande
The_Frame := Queue_Mail.First (The_Requests_Fifo);
Queue_Mail.Delete (The_Requests_Fifo);
Frame_Defs.Get (Frame_Defs.Service_Kind_Field,
The_Frame, The_Service_Kind);
Frame_Defs.Get (Frame_Defs.Service_Field,
The_Frame, The_Service);
Text_Io.Put_Line ("Agent is going to treat with " &
The_Service_Kind &
" and " & The_Service);
Treat_Result :=
V_String.Value (Treat
(The_Service_Kind, The_Service));
-- modification de la trame pour le retour
Frame_Defs.Set (Frame_Defs.Nom_Exp_Field,
Name, The_Frame);
Frame_Defs.Set (Frame_Defs.Service_Kind_Field,
"rjob", The_Frame);
Frame_Defs.Set (Frame_Defs.Service_Field,
"rjob", The_Frame);
Frame_Defs.Set (Frame_Defs.Message_Field,
Treat_Result, The_Frame);
Reverse_Adresses (The_Frame);
Send_Mail_To_Orb (200, The_Success, The_Frame);
end;
end if;
end select;
delay (3.0);
Text_Io.Put_Line ("Agent as a server is alive.");
exit when Done = True;
end loop;
end Agent_As_A_Server;
--
-- declarations des fonctions et procedures visibles
--
procedure Close is
begin
Agent_Mailer.Close (The_Connection);
Text_Io.Put_Line ("The connection was closed by the Agent.");
Letter_Box_Frames.Dispose;
Text_Io.Put_Line ("Letter box's agent disposed.");
Connector_Frames.Dispose;
Text_Io.Put_Line ("Connector's agent disposed.");
Agent_As_A_Server.Dispose;
Text_Io.Put_Line ("Server task disposed.");
Agent_As_A_Customer.Dispose;
Text_Io.Put_Line ("Customer task disposed.");
Dispatcher.Dispose;
Text_Io.Put_Line ("Dispatcher task disposed.");
end Close;
procedure Register (The_Contract_Descriptor : Contract_Descriptor) is
The_Frame : Frame_Defs.Frame;
begin
-- fabrication de la trame de registration
Frame_Defs.Init_Frame
(Name, Orb_Defs.Default_Orb_Socket, Orb_Defs.Default_Orb_Host,
Connector_Frames.Get_Current_Socket,
Transport.Local_Host (Orb_Defs.Network_Kind), 0, 0, "regi", "serv",
V_String.Image (The_Contract_Descriptor.Data), The_Frame);
Send_Mail_To_Orb (100, The_Success, The_Frame);
if The_Success = True then
Text_Io.Put_Line
("Registration Contract sending was successfull !");
else
Text_Io.Put_Line ("Registration Contract sending failed !!!");
end if;
end Register;
procedure Unregister is
The_Frame : Frame_Defs.Frame;
begin
-- fabrication de la trame de unregistration
Frame_Defs.Init_Frame
(Name, Orb_Defs.Default_Orb_Socket, Orb_Defs.Default_Orb_Host,
Connector_Frames.Get_Current_Socket,
Transport.Local_Host (Orb_Defs.Network_Kind), 0, 0, "unre",
"serv", "Happy to unregister", The_Frame);
Send_Mail_To_Orb (100, The_Success, The_Frame);
if The_Success = True then
Text_Io.Put_Line
("Unregistration Contract sending was successfull !");
else
Text_Io.Put_Line ("Unregistration Contract sending failed !!!");
end if;
end Unregister;
procedure Ask_For_A_Job (The_Wanted_Class : Orb_Defs.Class;
The_Wanted_Function : Orb_Defs.Funct;
The_Job_Number : in Natural) is
The_Frame : Frame_Defs.Frame;
begin
-- fabrication de la trame de demande
Frame_Defs.Init_Frame
(Name, Orb_Defs.Null_Socket_Id, Orb_Defs.Null_Host_Id,
Connector_Frames.Get_Current_Socket,
Transport.Local_Host (Orb_Defs.Network_Kind), 0, The_Job_Number,
The_Wanted_Class, The_Wanted_Function,
"I want you to find a worker for me !", The_Frame);
Send_Mail_To_Orb (100, The_Success, The_Frame);
if The_Success = True then
Text_Io.Put_Line ("Ask for a job sending was successfull !");
else
Text_Io.Put_Line ("Ask for a job sending sending failed !!!");
end if;
end Ask_For_A_Job;
function Is_There_A_Job_Result return Boolean is
The_Check : Boolean;
begin
Agent_As_A_Customer.Is_There_An_Answer (The_Check);
return The_Check;
end Is_There_A_Job_Result;
procedure Get_Job_Result
(The_Number : out Natural;
The_Job_Answer : in out V_String.Variable_String) is
The_Frame : Frame_Defs.Frame;
The_Service : Orb_Defs.Funct;
begin
Agent_As_A_Customer.Take_Job_Answer (The_Frame);
-- recuperer le numero de la reponse
Frame_Defs.Get (Frame_Defs.Message_Number_Field, The_Frame, The_Number);
Frame_Defs.Get (Frame_Defs.Service_Field, The_Frame, The_Service);
if The_Service = "fail" then
The_Job_Answer := V_String.Value ("fail");
else
-- recuperer le contenu de la reponse
Frame_Defs.Get (Frame_Defs.Message_Field,
The_Frame, The_Job_Answer);
end if;
end Get_Job_Result;
function Is_Registrated return Boolean is
begin
return Registrated;
end Is_Registrated;
-- methodes manipulant le descripteur de contrat
procedure Add_Field (The_Descriptor : in out Contract_Descriptor;
The_Item : String) is
begin
V_String.Append (The_Descriptor.Data, The_Item);
end Add_Field;
procedure Add_Field (The_Descriptor : in out Contract_Descriptor;
The_Number : Natural) is
begin
V_String.Append (The_Descriptor.Data, Natural'Image (The_Number));
end Add_Field;
end Generic_Agent;
nblk1=15
nid=5
hdr6=20
[0x00] rec0=25 rec1=00 rec2=01 rec3=046
[0x01] rec0=1d rec1=00 rec2=0c rec3=006
[0x02] rec0=17 rec1=00 rec2=13 rec3=026
[0x03] rec0=1b rec1=00 rec2=0a rec3=008
[0x04] rec0=1b rec1=00 rec2=04 rec3=012
[0x05] rec0=22 rec1=00 rec2=14 rec3=028
[0x06] rec0=21 rec1=00 rec2=02 rec3=04a
[0x07] rec0=1d rec1=00 rec2=12 rec3=04e
[0x08] rec0=11 rec1=00 rec2=0e rec3=014
[0x09] rec0=12 rec1=00 rec2=11 rec3=02c
[0x0a] rec0=1e rec1=00 rec2=0f rec3=012
[0x0b] rec0=18 rec1=00 rec2=07 rec3=028
[0x0c] rec0=15 rec1=00 rec2=06 rec3=056
[0x0d] rec0=19 rec1=00 rec2=15 rec3=054
[0x0e] rec0=1f rec1=00 rec2=09 rec3=07a
[0x0f] rec0=07 rec1=00 rec2=03 rec3=000
[0x10] rec0=01 rec1=00 rec2=0e rec3=000
[0x11] rec0=01 rec1=00 rec2=0e rec3=000
[0x12] rec0=07 rec1=00 rec2=09 rec3=032
[0x13] rec0=1f rec1=00 rec2=03 rec3=00a
[0x14] rec0=01 rec1=00 rec2=0e rec3=000
tail 0x21764511a87c77d7fb846 0x42a00088462060003
Free Block Chain:
0x5: 0000 00 10 03 fb 80 2b 20 20 20 20 20 20 20 20 20 20 ┆ + ┆
0x10: 0000 00 08 03 fc 00 42 20 20 20 20 20 20 20 20 20 20 ┆ B ┆
0x8: 0000 00 0d 03 f9 80 0f 65 6e 20 44 6f 6e 65 20 3d 20 ┆ en Done = ┆
0xd: 0000 00 0b 03 fc 80 05 31 33 32 29 2c 05 00 3e 20 20 ┆ 132), > ┆
0xb: 0000 00 00 01 81 80 04 6c 65 63 74 04 00 00 00 00 21 ┆ lect !┆