DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

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

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦72f0fcc7b⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Build_Testmate_Training_Users, seg_02ba35

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



with Access_List;
with Archive;
with Debug_Tools;
with Destroy_Users;
with Directory_Tools;
with Errors;
with Global_Replace;
with Io;
with Log;
with Operator;
with Name_Utilities;
with Pathnames;
with Profile;
with Switches;
procedure Build_Testmate_Training_Users
             (First_User_Number : in Positive := 1;
              Last_User_Number : in Positive;
              Username_Prefix : in String := "TestMate_USER";
              Destroy_Preexisting : in Boolean := False;
              Response : in String := "<PROFILE>") is

    package Error is
       new Errors (Profile.Get,  
                   Profile.Value (Response),  
                   "Build_TestMate_Training_Users",
                   "First_User_Number =>" & Positive'Image (First_User_Number) &
                      ", Last_User_Number =>" &
                      Positive'Image (Last_User_Number) &
                      ", Username_Prefix => """ & Username_Prefix &
                      """, Response => """ & Response & """");

    procedure Set_Privileges is
    begin
        Operator.Enable_Privileges (Enable => True);
        if Operator.Privileged_Mode /= True then
            Error.Report
               ("You must have operator capability to create training users",
                Nested => True);
        end if;
    end Set_Privileges;

    procedure Assert_Range_Valid (First : in Positive; Last : in Positive) is
    begin
        if First > Last then
            Error.Report
               ("First user number must be ""<"" or ""="" last user number",
                Nested => True);
        end if;
    end Assert_Range_Valid;

    procedure Assert_Username_Prefix_Valid
                 (This_Username_Prefix : in Pathnames.Simple_Name) is
    begin
        if not Name_Utilities.Is_Valid_Username_Prefix
                  (This_Username_Prefix) then
            Error.Report ("Invalid username prefix """ & This_Username_Prefix &
                          """, must be simple Ada name",
                          Nested => True);
        end if;
    end Assert_Username_Prefix_Valid;

    procedure Initialize_State
                 (User_Name : in Pathnames.Simple_Name;
                  Users_Full_Pathname : in Pathnames.Full_Name;
                  The_User : in out Directory_Tools.Object.Handle) is
    begin
        if not Directory_Tools.Object.Is_Bad (The_User) then
            if not Destroy_Preexisting then
                Error.Report ("User """ & User_Name & """ already exists",
                              Nested => True,
                              Suppress_Closing_Message => True);
            else
                Log.Put_Line ("Destroying preexisting user");
                Destroy_Users (Named => Users_Full_Pathname,
                               Response => "PERSEVERE," & Response);
                The_User := Directory_Tools.Naming.Resolution
                               (Users_Full_Pathname);
                if not Directory_Tools.Object.Is_Bad (The_User) then
                    Error.Report ("Unable to destroy preexisting user",
                                  Nested => True,
                                  Suppress_Closing_Message => True);
                end if;  
                Log.Put_Line ("Preexisting user destroyed",
                              Profile.Positive_Msg);
            end if;
        end if;
    end Initialize_State;

    procedure Create_Basic_User
                 (User_Name : in Pathnames.Simple_Name;
                  Users_Full_Pathname : in Pathnames.Full_Name) is
    begin
        Log.Put_Line ("Building user """ & User_Name & """");
        Operator.Create_User (User => User_Name,
                              Response => "PROPAGATE," & Response);
        Archive.Restore
           (Objects => "?",
            Use_Prefix => Users_Full_Pathname,
            For_Prefix =>              "!Users.Testmate_User_Training_Master", -- Name_Utilities.Master_Training_User,
            Options =>
               "R1000, BECOME_OWNER, PRIMARY, PROMOTE, WORLD_ACL=(NETWORK_PUBLIC => RWCOD), DEFAULT_ACL=(NETWORK_PUBLIC => RW), OBJECT_ACL=(NETWORK_PUBLIC => RW)",
            Device => Directory_Tools.Naming.Default_Context,
            Response => "PERSEVERE," & Response);
    end Create_Basic_User;

    procedure Finalize_State (Users_Full_Pathname : in Pathnames.Full_Name) is
    begin
        Log.Put_Line ("Setting ACLs for user");
        Access_List.Set (To_List => "Network_Public => RWCOD",
                         For_Object => "[" & Users_Full_Pathname & "," &
                                          Users_Full_Pathname & ".@??'V(ALL)]",
                         Response => "PERSEVERE," & Response);
        Log.Put_Line ("ACLs for user set", Profile.Positive_Msg);
    end Finalize_State;

begin
    Error.Prologue;
    Set_Privileges;
    Assert_Range_Valid (First_User_Number, Last_User_Number);
    Assert_Username_Prefix_Valid (Username_Prefix);
    for User_Count in First_User_Number .. Last_User_Number loop
        declare  
            User_Name : constant Pathnames.Simple_Name :=
               Name_Utilities.Simple_User_Name_From
                  (Username_Prefix, User_Count);
            Users_Full_Pathname : constant Pathnames.Full_Name :=
               Name_Utilities.Full_User_Name_From (Username_Prefix, User_Count);
            The_User : Directory_Tools.Object.Handle :=
               Directory_Tools.Naming.Resolution (Users_Full_Pathname);
        begin
            Initialize_State (User_Name, Users_Full_Pathname, The_User);
            Create_Basic_User (User_Name, Users_Full_Pathname);

            Switches.Set
               (Spec =>
                   "Testmate.Script_Construction_Control := " &
                      Users_Full_Pathname &
                      ".Tools.String_Support.Rev1_Working.Test.Script_Construction_Control",
                File =>
                   Users_Full_Pathname &
                      ".Tools.String_Support.Rev1_Working.State.Compiler_Switches",
                Response => "<PROFILE>");

            Switches.Set
               (Spec =>
                   "Testmate.Script_Execution_Control := " &
                      Users_Full_Pathname &
                      ".Tools.String_Support.Rev1_Working.Test.Script_Execution_Control",
                File =>
                   Users_Full_Pathname &
                      ".Tools.String_Support.Rev1_Working.State.Compiler_Switches",
                Response => "<PROFILE>");

            Switches.Set
               (Spec => "Testmate.Test_Context := " & Users_Full_Pathname &
                           ".Tools.String_Support.Rev1_Working.Test.Context",
                File =>
                   Users_Full_Pathname &
                      ".Tools.String_Support.Rev1_Working.State.Compiler_Switches",
                Response => "<PROFILE>");

            Finalize_State (Users_Full_Pathname);

        exception
            when others =>
                Error.Report ("Unable to build training user " & User_Name,
                              Fatal => False,
                              Nested => True);
        end;  
    end loop;

    Error.Epilogue;

exception
    when Error.Propagate =>
        raise;
    when Error.Quit =>
        null;
    when others =>
        Error.Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name,
                      Profile.Exception_Msg);

end Build_Testmate_Training_Users;

E3 Meta Data

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=1f rec1=00 rec2=01 rec3=012
        [0x01] rec0=1a rec1=00 rec2=02 rec3=088
        [0x02] rec0=15 rec1=00 rec2=03 rec3=01e
        [0x03] rec0=17 rec1=00 rec2=04 rec3=002
        [0x04] rec0=14 rec1=00 rec2=05 rec3=006
        [0x05] rec0=13 rec1=00 rec2=06 rec3=054
        [0x06] rec0=15 rec1=00 rec2=07 rec3=068
        [0x07] rec0=19 rec1=00 rec2=08 rec3=000
    tail 0x21724810483f078f685ae 0x42a00088462060003