|
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 - metrics - 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