|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Build_Testmate_Training_Users, seg_02ba35
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
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;
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