with Log; with Cmvc; with Names; with Errors; with Profile; with Library; with Operator; with Directory; with Work_Order; with Access_List; with Object_Info; with Compilation; with Debug_Tools; with Directory_Tools; with String_Utilities; with Design_Implementation; package body Destruction_Utilities is function Plural (For_Value : in Natural) return String is begin if (For_Value = 1) then return (""); else return ("s"); end if; end Plural; procedure Destroy_All (Of_These : in String := ""; Target_Key : in String := "R1000"; Response : in String := "") is -- Old_Response_Profile : Profile.Response_Profile := Profile.Get; New_Response_Profile : Profile.Response_Profile := Profile.Value (Response); -- package Error is new Errors (Old_Response_Profile, New_Response_Profile, "Destroy_All"); -- Initial_Objects : Object_Info.Objects := Directory_Tools.Naming.Resolution (Of_These); -- procedure Set_State_Of (This_Object : in Object_Info.Object) is -- The_Object : constant String := Directory_Tools.Naming.Full_Name (This_Object); -- Directory_Object : Directory.Object; The_Status : Directory.Error_Status; -- begin Access_List.Set (For_Object => The_Object); Library.Unfreeze (Existing => The_Object, Recursive => False); Cmvc.Check_In (What_Object => The_Object); Directory_Tools.Object.Low_Level.Get_Object (Handle => This_Object, The_Object => Directory_Object, Status => The_Status); Directory.Object_Operations.Set_Controlled (The_Object => Directory_Object, Value => False, Status => The_Status); Directory.Object_Operations.Set_Slushy (The_Object => Directory_Object, Value => False, Status => The_Status); if (Object_Info.Any.Is_World (This_Object)) then Library.Set_Subclass (Existing => The_Object, To_Subclass => "World"); Design_Implementation.Set_Target (To_Value => Target_Key, For_World => The_Object); end if; end Set_State_Of; -- procedure Set_State_Of (These_Objects : in out Object_Info.Objects) is begin Directory_Tools.Object.Reset (These_Objects); while (not Directory_Tools.Object.Done (These_Objects)) loop declare Current_Object : Object_Info.Object := Directory_Tools.Object.Value (These_Objects); Current_Closure : Object_Info.Objects := Object_Info.Any.All_Objects_In (This_Object => Current_Object, Transitive => True); Dummy : Boolean; begin Directory_Tools.Object.Add (Current_Closure, Current_Object, Dummy); Directory_Tools.Object.Reset (Current_Closure); while (not Directory_Tools.Object.Done (Current_Closure)) loop Set_State_Of (Directory_Tools.Object.Value (Current_Closure)); Directory_Tools.Object.Next (Current_Closure); end loop; end; Directory_Tools.Object.Next (These_Objects); end loop; end Set_State_Of; -- procedure Report_Results is -- Remaining : Natural := Object_Info.Any.Number_In (Directory_Tools.Naming.Resolution (Of_These)); -- begin if (Remaining > 0) then Error.Report ("Unable to destroy " & String_Utilities.Strip_Leading (Natural'Image (Remaining)) & " object" & Plural (Remaining), Nested => True); else Log.Put_Line ("[end of Destroy_All operation--0 could not be destroyed]", Profile.Positive_Msg); end if; end Report_Results; -- begin -- Log.Put_Line ("[Destroy_All (Of_These => """ & Of_These & ", Target_Key => """ & Target_Key & """, Response => """ & Response & """);]"); if (Object_Info.Any.Number_In (Initial_Objects) = 0) then Error.Report ("Cannot resolve any objects in """ & Of_These & """", This_Type => Profile.Warning_Msg, Nested => True); else Operator.Enable_Privileges (Enable => True); Work_Order.Set_Default_Venture (To_Venture => "<>"); Set_State_Of (Initial_Objects); Compilation.Destroy (Unit => Of_These, Threshold => Integer'Last, Limit => ""); Report_Results; end if; -- exception when Error.Propagate => raise; when Error.Quit => null; when others => Error.Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name, This_Type => Profile.Exception_Msg); -- end Destroy_All; procedure Destroy_Users (Named : in String := ""; Target_Key : in String := "R1000"; Response : in String := "") is -- Old_Response_Profile : Profile.Response_Profile := Profile.Get; New_Response_Profile : Profile.Response_Profile := Profile.Value (Response); -- package Error is new Errors (Old_Response_Profile, New_Response_Profile, "Destroy_Users"); -- Users : Directory_Tools.Object.Iterator := Directory_Tools.Naming.Resolution (Named); -- Initial_Number_Of_Objects : Natural := Object_Info.Any.Number_In (Users); -- User_Count : Natural := 0; -- procedure Verify_Name (This_User : in String) is begin if ((not Names.Is_Fully_Qualified_Pathname (This_User)) or else (not (Directory_Tools. Naming.Prefix (This_User) = "!USERS"))) then Error.Report ("Invalid user name """ & This_User & """", Fatal => False, Nested => True); end if; User_Count := User_Count + 1; end Verify_Name; -- procedure Destroy_User (This_User : in Directory_Tools.Object.Handle) is -- The_User_Full : constant String := Directory_Tools.Naming.Full_Name (This_User); -- The_User : constant String := Directory_Tools.Naming.Simple_Name (This_User); -- begin Verify_Name (The_User_Full); Operator.Delete_User (User => The_User, Response => ""); Destroy_All (Of_These => "!Machine.Groups." & The_User, Target_Key => Target_Key, Response => ""); Destroy_All (Of_These => "!Machine.Users." & The_User, Target_Key => Target_Key, Response => ""); Destroy_All (Of_These => "!Machine.Error_Logs." & The_User & "_@", Target_Key => Target_Key, Response => ""); Destroy_All (Of_These => "!Machine.Search_Lists." & The_User & "_@", Target_Key => Target_Key, Response => ""); Operator.Create_User (User => The_User, Response => ""); Operator.Delete_User (User => The_User, Response => ""); Destroy_All (Of_These => "!Machine.Groups." & The_User, Target_Key => Target_Key, Response => ""); Destroy_All (Of_These => "!Machine.Users." & The_User, Target_Key => Target_Key, Response => ""); Destroy_All (Of_These => "!Machine.Error_Logs." & The_User & "_@", Target_Key => Target_Key, Response => ""); Destroy_All (Of_These => "!Machine.Search_Lists." & The_User & "_@", Target_Key => Target_Key, Response => ""); Destroy_All (Of_These => "!Users." & The_User, Target_Key => Target_Key, Response => ""); end Destroy_User; -- procedure Report_Results is -- Remaining : Natural := Object_Info.Any.Number_In (Directory_Tools.Naming.Resolution (Named)); -- Expected_Number_Of_Leftover_Objects : Natural := Initial_Number_Of_Objects - User_Count; -- Number_Of_Undeleted_Users : Natural := Remaining - Expected_Number_Of_Leftover_Objects; -- begin if (Number_Of_Undeleted_Users > 0) then Error.Report ("Unable to destroy " & String_Utilities.Strip_Leading (Natural'Image (Number_Of_Undeleted_Users)) & " user" & Plural (Number_Of_Undeleted_Users), Nested => True); else Log.Put_Line ("[end of Destroy_Users operation--0 could not be destroyed]", Profile.Positive_Msg); end if; end Report_Results; -- begin -- Log.Put_Line ("[Destroy_Users (Named => """ & Named & ", Target_Key => """ & Target_Key & """, Response => """ & Response & """);]"); Operator.Enable_Privileges (Enable => True); Directory_Tools.Object.Reset (Users); if (Directory_Tools.Object.Done (Users)) then Error.Report ("Cannot resolve any users in """ & Named & """", This_Type => Profile.Warning_Msg, Nested => True); else Directory_Tools.Object.Reset (Users); while (not Directory_Tools.Object.Done (Users)) loop begin Destroy_User (Directory_Tools.Object.Value (Users)); -- exception when others => Error.Report (Error.Nil_Message, Fatal => False, Nested => True); end; Directory_Tools.Object.Next (Users); end loop; Report_Results; end if; -- exception when Error.Propagate => raise; when Error.Quit => null; when others => Error.Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name, This_Type => Profile.Exception_Msg); -- end Destroy_Users; end Destruction_Utilities;