|
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: 24576 (0x6000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Gateway_Driver, seg_00f32b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Debug_Tools;
-- with Common;
with Action;
with Directory;
with Dtia_Client;
use Dtia_Client;
with Gateway_Property;
with Gateway_Object;
with Io;
with Profile;
with Simple_Status;
with System;
with Device_Independent_Io;
with Multi_Requests;
package body Gateway_Driver is
subtype Gateway_Handle is Dtia_Client.Gateway_Handle;
subtype Image_Id is Dtia_Client.Image_Id;
subtype Selection is Dtia_Client.Selection;
subtype Cursor is Dtia_Client.Cursor;
Fatal_Error : exception;
package Requests is new Multi_Requests (Nb_Max_Connections, Max_Idle_Time);
task body Waiter is
begin
accept Stop;
end Waiter;
function Expand_Command (Command : in String; Directory, Name : in String)
return String is
Index_Target : Natural := 0;
procedure Append (Source : in String;
Target : in out String;
Index_Target : in out Natural;
Count_Only : in Boolean) is
begin
if not Count_Only then
Target (Index_Target + 1 .. Index_Target + Source'Length) :=
Source;
end if;
Index_Target := Index_Target + Source'Length;
end Append;
begin
for Nb_Loop in 1 .. 2 loop
declare
Dollar : Boolean := False;
Target : String (1 .. Index_Target);
begin
Index_Target := 0;
for Index in Command'Range loop
if Dollar then
case Command (Index) is
when 'D' =>
Append (Directory, Target,
Index_Target, Nb_Loop = 1);
when 'N' =>
Append (Name, Target, Index_Target,
Nb_Loop = 1);
-- when 'L' =>
-- Append ("" & Ascii.Lf, Target,
-- Index_Target, Nb_Loop = 1);
when '$' =>
Append ("$", Target, Index_Target, Nb_Loop = 1);
when others =>
Append ("$" & Command (Index), Target,
Index_Target, Nb_Loop = 1);
end case;
else
if Command (Index) /= '$' then
Append ("" & Command (Index), Target,
Index_Target, Nb_Loop = 1);
end if;
end if;
Dollar := Command (Index) = '$';
end loop;
if (Nb_Loop = 2) then
return Target;
end if;
end;
end loop;
end Expand_Command;
procedure Re_Open (H : in out Gateway_Handle) is
Error : Simple_Status.Condition;
begin
if not Gateway_Object.Is_Main_Object_Open_For_Update (H) then
Gateway_Object.Re_Open_Main_Object_For_Update (H, Error);
pragma Assert (not Simple_Status.Error
(Error, Simple_Status.Warning));
end if;
end Re_Open;
procedure Update_Image (Local_Name : in String; Image : Image_Id) is
File : Io.File_Type;
Line_Number : Natural := 0;
After_Line : Natural := Natural'Last;
begin
Io.Open (File, Io.In_File, Local_Name);
Dtia_Client.Delete_Lines (Image, 1, Natural'Last - 10);
while not Io.End_Of_File (File) loop
Dtia_Client.Insert_Lines (Image, After_Line, Io.Get_Line (File));
Line_Number := Line_Number + 1;
end loop;
Io.Close (File);
exception
when others =>
Io.Echo ("Exception: " & Debug_Tools.Get_Exception_Name &
" Unable to update create image" & Ascii.Lf);
raise Fatal_Error;
end Update_Image;
procedure Get_If_Bad_Date (Current_Object : Requests.Object_Id;
G_Handle : Gateway_Handle;
Image : Image_Id;
First_Time : Boolean;
Local_Name, Ws_Name : in String) is
Success : Boolean := True;
New_Image : Boolean := False;
Date_R1000_Object, Date_Ws_Object : Natural := 0;
Status : Simple_Status.Condition;
begin
Requests.Last_Update (Current_Object, Ws_Name, Date_Ws_Object, Status);
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
end if;
if Simple_Status.Error (Status, Simple_Status.Warning) then
Io.Echo ("Unknown Remote Object" & Ascii.Lf);
Date_Ws_Object := 0;
end if;
Date_R1000_Object := Natural'Value
(Gateway_Property.Value
(G_Handle, "Data.Last_Ws_Stamp"));
if Date_Ws_Object /= 0 then
if Date_R1000_Object < Date_Ws_Object then
Requests.Get (Current_Object, Ws_Name,
Local_Name, False, Status);
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
end if;
if Simple_Status.Error (Status, Simple_Status.Warning) then
Io.Echo ("Copy from Ws unsuccessful" & Ascii.Lf);
else New_Image := True;
-- Copy from ws successful
Gateway_Property.Set_Value
(G_Handle, "Data.Last_Ws_Stamp",
Natural'Image (Date_Ws_Object), Success);
if not Success then
Io.Echo ("Last_Ws_Stamp not updated " &
"(gateway_property.Set_Value error)" &
Ascii.Lf);
end if;
end if;
end if;
end if;
if First_Time or else New_Image then
Update_Image
(Dtia_Client.Objects_Name (Image) & "." &
Gateway_Property.Value (G_Handle, "Edit.Object"), Image);
Gateway_Object.Commit (G_Handle, False, Status);
end if;
end Get_If_Bad_Date;
procedure Put_And_Set_Date (Current_Object : Requests.Object_Id;
G_Handle : Gateway_Handle;
Local_Name, Ws_Name : in String) is
Success : Boolean := True;
Date_Ws_Object : Natural := 0;
Status : Simple_Status.Condition;
begin
Requests.Put (Current_Object, Local_Name, Ws_Name, Status);
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
end if;
if Simple_Status.Error (Status, Simple_Status.Warning) then
Io.Echo ("Copy to ws unsuccessful" & Ascii.Lf);
end if;
Requests.Last_Update (Current_Object, Ws_Name, Date_Ws_Object, Status);
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
end if;
if Simple_Status.Error (Status, Simple_Status.Warning) then
Io.Echo ("Unable to get new Ws Stamp Date" & Ascii.Lf);
Date_Ws_Object := 0;
end if;
if Date_Ws_Object /= 0 then
Gateway_Object.Set_Value
(G_Handle, "Data.Last_Ws_Stamp",
New_Value => Natural'Image (Date_Ws_Object));
if not Success then
null;
Io.Echo ("Last_Ws_Stamp not updated " &
"(gateway_property.Set_Value error)" & Ascii.Lf);
end if;
end if;
end Put_And_Set_Date;
procedure Build_Image (Handle : Gateway_Handle;
Visible : Boolean;
In_Place : Boolean;
First_Time : Boolean;
Read_Only : in out Boolean;
Image : Image_Id;
No_Image : out Boolean;
Underlying_Object : out Directory.Object) is
Current_Object : Requests.Object_Id;
G_Handle : Gateway_Handle := Handle;
Connected : Boolean;
Status : Simple_Status.Condition;
Status_Naming : Directory.Naming.Name_Status;
begin
Re_Open (G_Handle);
No_Image := False;
Directory.Naming.Resolve
(Dtia_Client.Objects_Name (Image) & "." &
Gateway_Property.Value (G_Handle, "Edit.Object"),
Underlying_Object, Status_Naming);
pragma Assert (Directory.Naming."="
(Status_Naming, Directory.Naming.Successful));
Connected := Boolean'Value
(Gateway_Property.Value (G_Handle, "Connected"));
if not Connected then
Io.Echo ("No Server Connected" & Ascii.Lf);
else
Requests.Init_Object (Current_Object, Gateway_Property.Value
(G_Handle, "Data.Host"));
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
end if;
Get_If_Bad_Date (Current_Object, G_Handle, Image, First_Time,
Dtia_Client.Objects_Name (Image) &
"." & Gateway_Property.Value
(G_Handle, "Edit.Object"),
Gateway_Property.Value (G_Handle, "Data.Context") &
Gateway_Property.Value
(G_Handle, "Data.Context_Separator") &
Gateway_Property.Value (G_Handle, "Data.Name") &
Gateway_Property.Value
(G_Handle, "Data.Suffix"));
Requests.Disconnect (C => Current_Object, Status => Status);
end if;
pragma Assert (not Simple_Status.Error (Status, Simple_Status.Warning));
exception
when Fatal_Error =>
Gateway_Object.Commit (G_Handle, False, Status);
pragma Assert (not Simple_Status.Error
(Status, Simple_Status.Warning));
null;
when others =>
Io.Echo ("Exception: " & Debug_Tools.Get_Exception_Name & Ascii.Lf);
Gateway_Object.Commit (G_Handle, False, Status);
pragma Assert (not Simple_Status.Error
(Status, Simple_Status.Warning));
end Build_Image;
procedure Post_Commit (Handle : Gateway_Handle;
Image : Image_Id) is
Current_Object : Requests.Object_Id;
G_Handle : Gateway_Handle := Handle;
Connected : Boolean;
Status : Simple_Status.Condition;
begin
Re_Open (G_Handle);
Connected := Boolean'Value
(Gateway_Property.Value (G_Handle, "Connected"));
if not Connected then
Io.Echo ("No Server Connected" & Ascii.Lf);
else
Requests.Init_Object (Current_Object, Gateway_Property.Value
(G_Handle, "Data.Host"));
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
end if;
Put_And_Set_Date (Current_Object, G_Handle,
Dtia_Client.Objects_Name (Image) &
"." & Gateway_Property.Value
(G_Handle, "Edit.Object"),
Gateway_Property.Value
(G_Handle, "Data.Context") &
Gateway_Property.Value
(G_Handle, "Data.Context_Separator") &
Gateway_Property.Value (G_Handle, "Data.Name") &
Gateway_Property.Value (G_Handle, "Data.Suffix"));
Requests.Disconnect (C => Current_Object, Status => Status);
end if;
pragma Assert (not Simple_Status.Error (Status, Simple_Status.Warning));
exception
when Fatal_Error =>
null;
when others =>
Io.Echo ("Exception: " & Debug_Tools.Get_Exception_Name & Ascii.Lf);
pragma Assert (not Simple_Status.Error
(Status, Simple_Status.Warning));
null;
end Post_Commit;
procedure Shell (G_Handle : Gateway_Handle; Command_Property : in String) is
Current_Object : Requests.Object_Id;
Connected : Boolean;
Status : Simple_Status.Condition;
begin
Connected := Boolean'Value
(Gateway_Property.Value (G_Handle, "Connected"));
if not Connected then
Io.Echo ("No Server Connected" & Ascii.Lf);
else
Requests.Init_Object (Current_Object, Gateway_Property.Value
(G_Handle, "Data.Host"));
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
end if;
Requests.Input_To_Remote_Shell
(Current_Object,
Expand_Command
(Gateway_Property.Value (G_Handle, Command_Property),
Gateway_Property.Value (G_Handle, "Data.Context"),
Gateway_Property.Value (G_Handle, "Data.Name")),
Integer'Value
(Gateway_Property.Value (G_Handle, "Shell.Timeout")),
Status);
if Simple_Status.Error (Status, Simple_Status.Fatal) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
raise Fatal_Error;
elsif Simple_Status.Error (Status) then
Io.Echo (Simple_Status.Display_Message (Status) & Ascii.Lf);
end if;
end if;
end Shell;
procedure Semanticize (Handle : Gateway_Handle;
Image : Image_Id;
S : Selection;
C : Cursor) is
Current_Object : Requests.Object_Id;
G_Handle : Gateway_Handle := Handle;
Success : Boolean;
begin
Re_Open (G_Handle);
Requests.Init_Object (Current_Object,
Gateway_Property.Value (G_Handle, "Data.Host"));
if Dtia_Client.Is_Modified (Image => Image) then
Dtia_Client.Commit (Image => Image, Success => Success);
if not Success then
Io.Echo ("Unable to Commit Changes" & Ascii.Lf);
return;
end if;
Put_And_Set_Date (Current_Object, G_Handle,
Dtia_Client.Objects_Name (Image) &
"." & Gateway_Property.Value
(G_Handle, "Edit.Object"),
Gateway_Property.Value
(G_Handle, "Data.Context") &
Gateway_Property.Value
(G_Handle, "Data.Context_Separator") &
Gateway_Property.Value (G_Handle, "Data.Name") &
Gateway_Property.Value (G_Handle, "Data.Suffix"));
end if;
Shell (G_Handle, "Semanticize.Command");
exception
when others =>
Io.Echo ("Exception: " & Debug_Tools.Get_Exception_Name & Ascii.Lf);
end Semanticize;
procedure Promote (Handle : Gateway_Handle;
Image : Image_Id;
S : Selection;
C : Cursor) is
Current_Object : Requests.Object_Id;
G_Handle : Gateway_Handle := Handle;
begin
if not Dtia_Client.Is_Read_Only (Image) then
-- if Dtia_Client.Is_Modified (Image => Image) then
-- Re_Open (G_Handle);
-- Requests.Init_Object (Current_Object,
-- Gateway_Property.Value
-- (G_Handle, "Data.Host"),
-- Gateway_Property.Value
-- (G_Handle, "Data.Remote_User"),
-- Gateway_Property.Value
-- (G_Handle, "Data.Remote_Password"));
-- Put_And_Set_Date (Current_Object, G_Handle,
-- Dtia_Client.Objects_Name (Image) &
-- "." & Gateway_Property.Value
-- (G_Handle, "Edit.Object"),
-- Gateway_Property.Value
-- (G_Handle, "Data.Context") &
-- Gateway_Property.Value
-- (G_Handle, "Data.Context_Separator") &
-- Gateway_Property.Value
-- (G_Handle, "Data.Name") &
-- Gateway_Property.Value
-- (G_Handle, "Data.Suffix"));
-- end if;
Dtia_Client.Make_Read_Only (Image);
Shell (G_Handle, "Promot.Command1");
else
Shell (G_Handle, "Promot.Command2");
end if;
exception
when others =>
Io.Echo ("Exception: " & Debug_Tools.Get_Exception_Name & Ascii.Lf);
end Promote;
procedure Format (Handle : Gateway_Handle;
Image : Image_Id;
S : Selection;
C : Cursor) is
Current_Object : Requests.Object_Id;
G_Handle : Gateway_Handle := Handle;
Ignored : Simple_Status.Condition;
Success : Boolean;
begin
Re_Open (G_Handle);
Requests.Init_Object (Current_Object,
Gateway_Property.Value (G_Handle, "Data.Host"));
if Dtia_Client.Is_Read_Only (Image => Image) then
Io.Echo ("Image is Read_Only" & Ascii.Lf);
else
if Dtia_Client.Is_Modified (Image => Image) then
Dtia_Client.Commit (Image => Image, Success => Success);
if not Success then
Io.Echo ("Unable to commit changes" & Ascii.Lf);
return;
end if;
Put_And_Set_Date (Current_Object, G_Handle,
Dtia_Client.Objects_Name (Image) &
"." & Gateway_Property.Value
(G_Handle, "Edit.Object"),
Gateway_Property.Value
(G_Handle, "Data.Context") &
Gateway_Property.Value
(G_Handle, "Data.Context_Separator") &
Gateway_Property.Value
(G_Handle, "Data.Name") &
Gateway_Property.Value
(G_Handle, "Data.Suffix"));
end if;
Shell (G_Handle, "Format.Command");
Get_If_Bad_Date (Current_Object, G_Handle, Image, True,
Dtia_Client.Objects_Name (Image) &
"." & Gateway_Property.Value
(G_Handle, "Edit.Object"),
Gateway_Property.Value (G_Handle, "Data.Context") &
Gateway_Property.Value
(G_Handle, "Data.Context_Separator") &
Gateway_Property.Value (G_Handle, "Data.Name") &
Gateway_Property.Value
(G_Handle, "Data.Suffix"));
end if;
Requests.Disconnect (C => Current_Object, Status => Ignored);
exception
when others =>
Io.Echo ("Exception: " & Debug_Tools.Get_Exception_Name & Ascii.Lf);
end Format;
procedure Terminate_Server (Reason : Dtia_Client.Termination_Condition) is
Status : Simple_Status.Condition;
begin
Requests.Shut_Down;
Waiter.Stop;
end Terminate_Server;
package Driver is new Dtia_Client.Dtia_Client_Operations
(Class_Name => "remote_file",
--!!! Session_Server => True,
Session_Server => False,
Promote => Promote,
Build_Image => Build_Image,
Post_Commit => Post_Commit,
Semanticize => Semanticize,
Format => Format,
-- Revert => Revert,
Terminate_Server => Terminate_Server);
end Gateway_Driver;
nblk1=17
nid=0
hdr6=2e
[0x00] rec0=26 rec1=00 rec2=01 rec3=036
[0x01] rec0=18 rec1=00 rec2=02 rec3=018
[0x02] rec0=13 rec1=00 rec2=03 rec3=02a
[0x03] rec0=18 rec1=00 rec2=04 rec3=056
[0x04] rec0=17 rec1=00 rec2=05 rec3=00a
[0x05] rec0=14 rec1=00 rec2=06 rec3=002
[0x06] rec0=16 rec1=00 rec2=07 rec3=04a
[0x07] rec0=15 rec1=00 rec2=08 rec3=034
[0x08] rec0=18 rec1=00 rec2=09 rec3=03a
[0x09] rec0=15 rec1=00 rec2=0a rec3=068
[0x0a] rec0=12 rec1=00 rec2=0b rec3=080
[0x0b] rec0=17 rec1=00 rec2=0c rec3=08c
[0x0c] rec0=13 rec1=00 rec2=0d rec3=03a
[0x0d] rec0=17 rec1=00 rec2=0e rec3=038
[0x0e] rec0=13 rec1=00 rec2=0f rec3=04a
[0x0f] rec0=18 rec1=00 rec2=10 rec3=006
[0x10] rec0=15 rec1=00 rec2=11 rec3=016
[0x11] rec0=11 rec1=00 rec2=12 rec3=068
[0x12] rec0=15 rec1=00 rec2=13 rec3=034
[0x13] rec0=16 rec1=00 rec2=14 rec3=04c
[0x14] rec0=10 rec1=00 rec2=15 rec3=070
[0x15] rec0=18 rec1=00 rec2=16 rec3=072
[0x16] rec0=0b rec1=00 rec2=17 rec3=000
tail 0x2170bb932822a65c37bf8 0x42a00088462060003