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

⟦94efbaa2c⟧ TextFile

    Length: 21938 (0x55b2)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦6d381756c⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦6d381756c⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦6d381756c⟧ 
            └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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;