From eafc137c693811cdc0df73ef3821d4bb5ba45855 Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Sat, 12 Nov 2022 12:55:23 +1100 Subject: [PATCH] lace.environ.*: Cosmetics. --- .../environ/lace-environ-os_commands.adb | 14 +- .../environ/lace-environ-os_commands.ads | 10 +- .../source/environ/lace-environ-paths.adb | 142 +++++++++++++----- .../source/environ/lace-environ-paths.ads | 59 +++++--- .../source/environ/lace-environ-users.adb | 23 ++- .../source/environ/lace-environ-users.ads | 8 +- 1-base/lace/source/environ/lace-environ.adb | 20 ++- 1-base/lace/source/environ/lace-environ.ads | 4 + 8 files changed, 197 insertions(+), 83 deletions(-) diff --git a/1-base/lace/source/environ/lace-environ-os_commands.adb b/1-base/lace/source/environ/lace-environ-os_commands.adb index 1a0db05..2906104 100644 --- a/1-base/lace/source/environ/lace-environ-os_commands.adb +++ b/1-base/lace/source/environ/lace-environ-os_commands.adb @@ -8,6 +8,7 @@ with ada.Characters.latin_1, ada.Exceptions; + package body lace.Environ.OS_Commands is use ada.Exceptions; @@ -21,18 +22,21 @@ is end Path_to; + procedure run_OS (command_Line : in String; Input : in String := "") is use Shell; begin Commands.unsafe.run (command_Line, +Input); + exception when E : Commands.command_Error => raise Error with Exception_Message (E); end run_OS; + function run_OS (command_Line : in String; Input : in String := ""; add_Errors : in Boolean := True) return String @@ -41,6 +45,7 @@ is Shell.Commands, Shell.Commands.unsafe; + function trim_LF (Source : in String) return String is use ada.Strings.fixed, @@ -52,8 +57,10 @@ is return trim (Source, LF_Set, LF_Set); end trim_LF; + Results : constant Command_Results := run (command_Line, +Input); Output : constant String := +Output_of (Results); + begin if add_Errors then @@ -68,15 +75,19 @@ is end run_OS; + function run_OS (command_Line : in String; Input : in String := "") return Data is use Shell, Shell.Commands, Shell.Commands.unsafe; + the_Command : unsafe.Command := Forge.to_Command (command_Line); + begin return Output_of (run (The_Command, +Input)); + exception when E : command_Error => raise Error with Exception_Message (E); @@ -89,8 +100,9 @@ is use Paths, gnat.OS_Lib; - File_Path : String_Access := Locate_Exec_On_Path (+Executable); + File_Path : String_Access := locate_Exec_on_Path (+Executable); Found : constant Boolean := File_Path /= null; + begin free (File_Path); return Found; diff --git a/1-base/lace/source/environ/lace-environ-os_commands.ads b/1-base/lace/source/environ/lace-environ-os_commands.ads index bdce0ee..def7117 100644 --- a/1-base/lace/source/environ/lace-environ-os_commands.ads +++ b/1-base/lace/source/environ/lace-environ-os_commands.ads @@ -1,23 +1,26 @@ with lace.Environ.Paths; + package lace.Environ.OS_Commands -- -- Allows running of operating system commands. -- is - function Path_to (Command : in String) return Paths.Folder; + procedure run_OS (command_Line : in String; Input : in String := ""); -- - -- Discards any output. Error is raised when the command fails. + -- Discards any output. The 'Error' exception is raised if the command fails. + function run_OS (command_Line : in String; Input : in String := "") return Data; -- - -- Returns any output. Error is raised when the command fails. + -- Returns any output. The 'Error' exception is raised if the command fails. + function run_OS (command_Line : in String; Input : in String := ""; @@ -30,4 +33,5 @@ is -- -- Returns True if the Executable exists on the environment PATH variable. + end lace.Environ.OS_Commands; diff --git a/1-base/lace/source/environ/lace-environ-paths.adb b/1-base/lace/source/environ/lace-environ-paths.adb index bbf4414..1d74018 100644 --- a/1-base/lace/source/environ/lace-environ-paths.adb +++ b/1-base/lace/source/environ/lace-environ-paths.adb @@ -1,6 +1,7 @@ with lace.Environ.OS_Commands, lace.Text.utility, + posix.file_Status, posix.Calendar, @@ -16,6 +17,7 @@ with ada.Text_IO, ada.IO_Exceptions; + package body lace.Environ.Paths is ----------- @@ -26,6 +28,7 @@ is renames to_String; + function expand_GLOB (GLOB : in String) return String is use ada.Text_IO; @@ -61,6 +64,7 @@ is end to_String; + procedure check (Self : in Path'Class) is use ada.Tags, @@ -83,6 +87,7 @@ is end check; + procedure link (Self, To : in Path) is begin @@ -95,7 +100,6 @@ is & " " & (+To)); begin - if Output /= "" then raise Error with Output; @@ -104,6 +108,7 @@ is end link; + procedure change_Mode (Self : in Path; To : in String) is @@ -122,6 +127,7 @@ is end change_Mode; + procedure change_Owner (Self : in Path; To : in String) is @@ -140,6 +146,7 @@ is end change_Owner; + function Exists (Self : in Path) return Boolean is begin @@ -148,10 +155,11 @@ is raise Error with "No path specified."; end if; - return ada.Directories.Exists (+Self); + return ada.Directories.exists (+Self); end Exists; + function is_Folder (Self : in Path) return Boolean is use ada.Directories; @@ -161,6 +169,7 @@ is end is_Folder; + function is_File (Self : in Path) return Boolean is use ada.Directories; @@ -170,6 +179,7 @@ is end is_File; + function is_Special (Self : in Path) return Boolean is use ada.Directories; @@ -179,6 +189,7 @@ is end is_Special; + function is_Absolute (Self : in Path) return Boolean is begin @@ -191,6 +202,7 @@ is end is_Absolute; + function is_Relative (Self : in Path) return Boolean is begin @@ -198,17 +210,18 @@ is end is_Relative; + function modify_Time (Self : in Path) return ada.Calendar.Time is begin check (Self); declare - use POSIX, - POSIX.Calendar, - POSIX.File_Status; + use Posix, + posix.Calendar, + posix.File_Status; - the_Status : constant Status := get_File_Status (pathname => to_POSIX_String (+Self)); + the_Status : constant Status := get_File_Status (Pathname => to_posix_String (+Self)); Time : constant POSIX_Time := last_modification_Time_of (the_Status); begin return to_Time (Time); @@ -216,6 +229,7 @@ is end modify_Time; + function Parent (Self : in Path'Class) return Folder is begin @@ -247,10 +261,11 @@ is function Name (Self : in Path) return String is begin - return +Self.Name; + return +Self.Name; end Name; + function Simple (Self : in Path) return String is begin @@ -258,20 +273,21 @@ is declare use ada.Strings; - Idx : constant Natural := Index (Self.Name, "/", going => Backward); + i : constant Natural := Index (Self.Name, "/", going => Backward); Last : constant Natural := Length (Self.Name); begin - if Idx = 0 + if i = 0 then return +Self; else - return Slice (Self.Name, Low => Idx + 1, + return Slice (Self.Name, Low => i + 1, High => Last); end if; end; end Simple; + ----------- --- Folders -- @@ -279,15 +295,16 @@ is function to_Folder (Name : in String) return Folder is begin - return (Name => To_Unbounded_String (Name)); + return (Name => to_unbounded_String (Name)); end to_Folder; + function "+" (Left : in Folder; Right : in Folder) return Folder is + Result : Folder; R_Folder : constant String := (if Right.is_Absolute then Right.Simple else +Right); - Result : Folder; begin Result.Name := Left.Name; append (Result.Name, "/" & R_Folder); @@ -296,12 +313,13 @@ is end "+"; + function "+" (Left : in Folder'Class; Right : in File 'Class) return File is + Result : File; R_File : constant String := (if Right.is_Absolute then Right.Simple else +Right); - Result : File; begin Result.Name := Left.Name; append (Result.Name, "/" & R_File); @@ -310,6 +328,7 @@ is end "+"; + function current_Folder return Folder is begin @@ -317,6 +336,7 @@ is end current_Folder; + protected folder_Lock is entry change (To : in Folder); @@ -329,7 +349,7 @@ is protected body folder_Lock is entry change (To : in Folder) - when not Locked + when not Locked is begin check (To); @@ -337,6 +357,7 @@ is Locked := True; end change; + procedure clear is begin @@ -345,13 +366,14 @@ is end folder_Lock; - procedure go_to_Folder (Self : in Folder; - Lock : in Boolean := False) + + procedure go_to_Folder (Self : in Folder; + lock : in Boolean := False) is begin check (Self); - if Lock + if lock then folder_Lock.change (Self); else @@ -360,6 +382,7 @@ is end go_to_Folder; + procedure unlock_Folder is begin @@ -367,11 +390,12 @@ is end unlock_Folder; - function contents_Count (Self : in Folder; - Recurse : in Boolean := False) return Natural + + function contents_Count (Self : in Folder; + recurse : in Boolean := False) return Natural is - use Shell.Directory_Iteration, - Ada.Directories; + use shell.Directory_Iteration, + ada.Directories; Count : Natural := 0; begin @@ -382,7 +406,8 @@ is declare Name : constant String := Simple_Name (Each); begin - if not (Name = "." or Name = "..") + if not ( Name = "." + or Name = "..") then Count := Count + 1; end if; @@ -393,6 +418,7 @@ is end contents_Count; + function is_Empty (Self : in Folder) return Boolean is begin @@ -401,6 +427,7 @@ is end is_Empty; + procedure rid_Folder (Self : in Folder) is begin @@ -412,6 +439,7 @@ is end rid_Folder; + procedure copy_Folder (Self : in Folder; To : in Folder) is use lace.Environ.OS_Commands; @@ -423,6 +451,7 @@ is end copy_Folder; + procedure move_Folder (Self : in Folder; To : in Folder) is use lace.Environ.OS_Commands; @@ -434,6 +463,7 @@ is end move_Folder; + procedure rename_Folder (Self : in Folder; To : in Folder) is begin @@ -443,6 +473,7 @@ is end rename_Folder; + procedure ensure_Folder (Self : in Folder) is begin @@ -455,10 +486,12 @@ is end ensure_Folder; + function Relative (Self : in Folder; To : in Folder'Class) return Folder is use lace.Text, lace.Text.utility; + Filename : constant lace.Text.item := to_Text (+Self); relative_Folder : constant lace.Text.item := replace (Filename, pattern => +To & "/", by => ""); @@ -467,6 +500,7 @@ is end Relative; + ------------------- --- Folder Contexts -- @@ -482,6 +516,7 @@ is end push_Folder; + procedure pop_Folder (Context : in out folder_Context) is begin @@ -499,6 +534,7 @@ is end pop_Folder; + procedure pop_All (Context : in out folder_Context) is begin @@ -512,6 +548,7 @@ is end pop_All; + --------- --- Files -- @@ -525,6 +562,7 @@ is end to_File; + function "+" (Left : in File'Class; Right : in File_Extension) return File is @@ -533,6 +571,7 @@ is end "+"; + function Extension (Self : in File) return File_Extension is use ada.Directories; @@ -541,27 +580,30 @@ is end Extension; - procedure save (Self : in File; - Text : in String; - Binary : in Boolean := False) + + procedure save (Self : in File; Text : in String; + Binary : in Boolean := False) is begin if Binary then declare type binary_String is new String (Text'Range); + package Binary_IO is new ada.Direct_IO (binary_String); use Binary_IO; - File : File_Type; + + File : File_type; begin create (File, out_File, +Self); write (File, binary_String (Text)); close (File); end; + else declare use ada.Text_IO; - File : File_Type; + File : File_type; begin create (File, out_File, +Self); put (File, Text); @@ -571,16 +613,19 @@ is end save; - procedure save (Self : in File; - Data : in environ.Data) + + procedure save (Self : in File; Data : in environ.Data) is begin check (Self); + declare type Element_Array is new environ.Data (Data'Range); + package Binary_IO is new ada.Direct_IO (Element_Array); use Binary_IO; - File : File_Type; + + File : File_type; begin create (File, out_File, +Self); write (File, Element_Array (Data)); @@ -589,10 +634,11 @@ is end save; + function load (Self : in File) return String is use type ada.Directories.File_Size; - Size : ada.Directories.File_Size; + Size : ada.Directories.File_Size; begin check (Self); Size := ada.Directories.Size (+Self); @@ -608,7 +654,7 @@ is package String_IO is new ada.Direct_IO (my_String); use String_IO; - File : File_Type; + File : File_type; Result : my_String; begin open (File, in_File, +Self); @@ -619,15 +665,17 @@ is end; exception - when ada.IO_Exceptions.Name_Error => + when ada.IO_Exceptions.name_Error => raise Error with "Cannot load missing file: '" & (+Self) & "'"; end load; + function load (Self : in File) return Data is begin check (Self); + declare use ada.Streams; Size : constant ada.Directories.File_Size := ada.Directories.Size (+Self); @@ -637,7 +685,7 @@ is package Binary_IO is new ada.Direct_IO (Element_Array); use Binary_IO; - File : Binary_IO.File_Type; + File : Binary_IO.File_type; Result : Element_Array; begin open (File, out_File, +Self); @@ -648,11 +696,12 @@ is end; exception - when ada.IO_Exceptions.Name_Error => + when ada.IO_Exceptions.name_Error => raise Error with "Cannot load missing file: '" & (+Self) & "'"; end load; + procedure copy_File (Self : in File; To : in File) is begin @@ -663,13 +712,14 @@ is end copy_File; + procedure copy_Files (Named : in String; To : in Folder) is use lace.Text, lace.Text.all_Tokens, ada.Strings.fixed; - all_Files : constant String := (if Index (Named, "*") /= 0 then Expand_GLOB (Named) + all_Files : constant String := (if Index (Named, "*") /= 0 then expand_GLOB (Named) else Named); file_List : constant Text.items_1k := Tokens (to_Text (all_Files)); begin @@ -694,6 +744,7 @@ is end copy_Files; + procedure move_File (Self : in File; To : in File) is begin @@ -708,6 +759,7 @@ is end move_File; + procedure move_Files (Named : in String; To : in Folder) is begin @@ -745,6 +797,7 @@ is end move_Files; + procedure append (Self : in File; Text : in String) is begin @@ -761,6 +814,7 @@ is end append; + procedure append_File (Self : in File; To : in File) is begin @@ -780,6 +834,7 @@ is end append_File; + procedure rid_File (Self : in File) is begin @@ -788,6 +843,7 @@ is end rid_File; + procedure rid_Files (Named : in String) is use lace.Text, @@ -797,6 +853,7 @@ is all_Files : constant String := (if Index (Named, "*") /= 0 then Expand_GLOB (Named) else Named); file_List : constant Text.items_1k := Tokens (to_Text (all_Files)); + begin for Each of file_List loop @@ -806,6 +863,7 @@ is end rid_Files; + procedure touch (Self : in File) is use lace.Environ.OS_Commands; @@ -818,18 +876,21 @@ is end touch; + function Relative (Self : in File; To : in Folder'Class) return File is use lace.Text, lace.Text.utility; + Filename : constant lace.Text.item := to_Text (+Self); - relative_File : constant lace.Text.item := replace (Filename, pattern => +To & "/", - by => ""); + relative_File : constant lace.Text.item := replace (Filename, Pattern => +To & "/", + By => ""); begin return to_File (+relative_File); end Relative; + function rid_Extension (Self : in File) return File is use ada.Directories; @@ -852,6 +913,7 @@ is is use lace.Environ.OS_Commands; + function level_Flag return String is use ada.Strings, @@ -863,6 +925,7 @@ is & " "; end level_Flag; + begin check (the_Path); @@ -877,6 +940,7 @@ is when Tar_Gz => "-czf", when Tar_Xz => "-cJf", when others => raise program_Error); + Output : constant String := run_OS ( "tar " & Options & " " & (+the_Path) & format_Suffix (the_Format) & " " & (+the_Path)); @@ -924,6 +988,7 @@ is end compress; + procedure decompress (Name : in File) is use lace.Environ.OS_Commands; @@ -997,6 +1062,7 @@ is end decompress; + function format_Suffix (Format : compress_Format) return String is begin diff --git a/1-base/lace/source/environ/lace-environ-paths.ads b/1-base/lace/source/environ/lace-environ-paths.ads index cacda12..a09692e 100644 --- a/1-base/lace/source/environ/lace-environ-paths.ads +++ b/1-base/lace/source/environ/lace-environ-paths.ads @@ -6,9 +6,10 @@ with ada.Strings.unbounded, ada.Containers.indefinite_Vectors; + package lace.Environ.Paths -- --- A singleton which models an operating system environment. +-- A singleton which models an operating system paths, folders and files. -- is @@ -41,11 +42,13 @@ is function is_Relative (Self : in Path) return Boolean; + ----------- --- Folders -- type Folder is new Path with private; + no_Folder : constant Folder; function to_Folder (Name : in String) return Folder; @@ -58,7 +61,7 @@ is procedure go_to_Folder (Self : in Folder; - Lock : in Boolean := False); -- When true, blocks further folder changes until 'unlock_Folder' is called. + lock : in Boolean := False); -- When true, blocks further folder changes until 'unlock_Folder' is called. procedure unlock_Folder; @@ -66,14 +69,15 @@ is procedure copy_Folder (Self : in Folder; To : in Folder); procedure move_Folder (Self : in Folder; To : in Folder); procedure rename_Folder (Self : in Folder; To : in Folder); - procedure ensure_Folder (Self : in Folder); -- Ensure that the folder exists. + procedure ensure_Folder (Self : in Folder); -- Ensure that the folder exists. function is_Empty (Self : in Folder) return Boolean; - function contents_Count (Self : in Folder; -- Does not include the "." and ".." folders. - Recurse : in Boolean := False) return Natural; + function contents_Count (Self : in Folder; -- Does not include the "." and ".." folders. + recurse : in Boolean := False) return Natural; + + function Parent (Self : in Path'Class) return Folder; -- Returns 'no_Folder' if 'Self' has no parent. + function Relative (Self : in Folder; to : in Folder'Class) return Folder; - function Parent (Self : in Path'Class) return Folder; -- Returns 'no_Folder' if 'Self' has no parent. - function Relative (Self : in Folder; To : in Folder'Class) return Folder; ------------------- @@ -89,10 +93,13 @@ is procedure pop_Folder (Context : in out folder_Context); -- -- Return to the previously pushed folder. + -- Raises 'Error' if no previous folder has been pushed. procedure pop_All (Context : in out folder_Context); -- -- Return to the initial current folder. + -- Raises 'Error' if no previous folder has been pushed. + --------- @@ -110,33 +117,38 @@ is function "+" (Left : in File'Class; Right : in File_Extension) return File; - function Extension (Self : in File) return File_Extension; - procedure save (Self : in File; - Text : in String; - Binary : in Boolean := False); + function Extension (Self : in File) return File_Extension; - procedure save (Self : in File; - Data : in environ.Data); - function load (Self : in File) return String; - function load (Self : in File) return Data; + procedure save (Self : in File; Text : in String; + Binary : in Boolean := False); - procedure copy_File (Self : in File; To : in File); - procedure copy_Files (Named : in String; To : in Folder); + procedure save (Self : in File; Data : in environ.Data); + + + function load (Self : in File) return String; -- Raises 'Error' if the file does not exist. + function load (Self : in File) return Data; -- Raises 'Error' if the file does not exist. + + + procedure copy_File (Self : in File; To : in File); + procedure copy_Files (Named : in String; To : in Folder); -- -- 'Named' can contain an asterix GLOB such as "*" or "*.txt". - procedure move_File (Self : in File; To : in File); - procedure move_Files (Named : in String; To : in Folder); + + procedure move_File (Self : in File; To : in File); + procedure move_Files (Named : in String; To : in Folder); -- -- 'Named' can contain an asterix GLOB such as "*" or "*.txt". - procedure rid_File (Self : in File); - procedure rid_Files (Named : in String); + + procedure rid_File (Self : in File); + procedure rid_Files (Named : in String); -- -- 'Named' can contain an asterix GLOB such as "*" or "*.txt". + procedure append (Self : in File; Text : in String); procedure append_File (Self : in File; To : in File); procedure touch (Self : in File); @@ -145,12 +157,14 @@ is function rid_Extension (Self : in File) return File; + --- Compression -- type compress_Format is (Tar, Tar_Bz2, Tar_Gz, Tar_Xz, Bz2, Gz, Xz); subtype folder_compress_Format is compress_Format range Tar .. Tar_Xz; - type compress_Level is range 1 .. 9; -- Higher levels result in higher compression. + type compress_Level is range 1 .. 9; -- Higher levels result in greater compression. + procedure compress (the_Path : in Path'Class; the_Format : in compress_Format := Tar_Xz; @@ -166,6 +180,7 @@ private use ada.Strings.unbounded; + type Path is abstract tagged record Name : unbounded_String; diff --git a/1-base/lace/source/environ/lace-environ-users.adb b/1-base/lace/source/environ/lace-environ-users.adb index 692fc18..c448bfd 100644 --- a/1-base/lace/source/environ/lace-environ-users.adb +++ b/1-base/lace/source/environ/lace-environ-users.adb @@ -4,8 +4,10 @@ with posix.user_Database, posix.process_Identification; + package body lace.Environ.Users is + function "+" (Source : in unbounded_String) return String renames to_String; @@ -18,6 +20,7 @@ is end to_User; + function Name (Self : in User) return String is begin @@ -25,8 +28,8 @@ is end Name; - procedure add_User (Self : in User; - Super : in Boolean := False) + + procedure add_User (Self : in User; Super : in Boolean := False) is use lace.Environ.OS_Commands; begin @@ -40,6 +43,7 @@ is raise Error with Output; end if; end; + else declare Output : constant String := run_OS ("useradd " & (+Self.Name) & " -m"); @@ -53,9 +57,11 @@ is end add_User; + procedure rid_User (Self : in User) is use lace.Environ.OS_Commands; + Output : constant String := run_OS ("userdel -r " & (+Self.Name)); begin if Output /= "" @@ -65,19 +71,21 @@ is end rid_User; + procedure switch_to (Self : in User) is use Posix, - posix.User_Database, - posix.Process_Identification; + posix.user_Database, + posix.process_Identification; - User_in_DB : constant User_Database_Item := get_User_Database_Item (to_Posix_String (+Self.Name)); + User_in_DB : constant User_Database_item := get_User_Database_item (to_Posix_String (+Self.Name)); ID : constant User_ID := User_ID_of (User_in_DB); begin set_User_ID (ID); end switch_to; + function current_User return User is use Posix, @@ -87,13 +95,14 @@ is end current_User; + function home_Folder (Self : in User := current_User) return Paths.Folder is use Paths, Posix, - posix.User_Database; + posix.user_Database; - User_in_DB : constant User_Database_Item := get_User_Database_Item (to_Posix_String (+Self.Name)); + User_in_DB : constant User_Database_item := get_User_Database_item (to_Posix_String (+Self.Name)); begin return to_Folder (to_String (initial_Directory_of (User_in_DB))); end home_Folder; diff --git a/1-base/lace/source/environ/lace-environ-users.ads b/1-base/lace/source/environ/lace-environ-users.ads index 7ca3cbc..4c04b96 100644 --- a/1-base/lace/source/environ/lace-environ-users.ads +++ b/1-base/lace/source/environ/lace-environ-users.ads @@ -5,6 +5,7 @@ private with ada.Strings.unbounded; + package lace.Environ.Users -- -- Models operating system users. @@ -19,10 +20,9 @@ is function current_User return User; function home_Folder (Self : in User := current_User) return Paths.Folder; - procedure add_User (Self : in User; - Super : in Boolean := False); - procedure rid_User (Self : in User); - procedure switch_to (Self : in User); + procedure add_User (Self : in User; Super : in Boolean := False); + procedure rid_User (Self : in User); + procedure switch_to (Self : in User); diff --git a/1-base/lace/source/environ/lace-environ.adb b/1-base/lace/source/environ/lace-environ.adb index c0683e4..2462fd4 100644 --- a/1-base/lace/source/environ/lace-environ.adb +++ b/1-base/lace/source/environ/lace-environ.adb @@ -3,38 +3,42 @@ is function to_octal_Mode (Permissions : in permission_Set) return String is + function octal_Permissions (Bit_3, Bit_2, Bit_1 : in Boolean) return String is begin if Bit_3 then if Bit_2 then if Bit_1 then return "7"; - else return "6"; + else return "6"; end if; else if Bit_1 then return "5"; - else return "4"; + else return "4"; end if; end if; + else if Bit_2 then if Bit_1 then return "3"; - else return "2"; + else return "2"; end if; else if Bit_1 then return "1"; - else return "0"; + else return "0"; end if; end if; + end if; end octal_Permissions; + begin return - octal_Permissions (Permissions (set_User_ID), Permissions (set_Group_ID), False) - & octal_Permissions (Permissions (owner_Read), Permissions (owner_Write), Permissions (owner_Execute)) - & octal_Permissions (Permissions (group_Read), Permissions (group_Write), Permissions (group_Execute)) - & octal_Permissions (Permissions (others_Read), Permissions (others_Write), Permissions (others_Execute)); + octal_Permissions (Permissions (set_User_ID), Permissions (set_Group_ID), False) + & octal_Permissions (Permissions (owner_Read), Permissions (owner_Write), Permissions (owner_Execute)) + & octal_Permissions (Permissions (group_Read), Permissions (group_Write), Permissions (group_Execute)) + & octal_Permissions (Permissions (others_Read), Permissions (others_Write), Permissions (others_Execute)); end to_octal_Mode; end lace.Environ; diff --git a/1-base/lace/source/environ/lace-environ.ads b/1-base/lace/source/environ/lace-environ.ads index 1531a99..2618d00 100644 --- a/1-base/lace/source/environ/lace-environ.ads +++ b/1-base/lace/source/environ/lace-environ.ads @@ -2,16 +2,20 @@ with posix.Permissions, ada.Streams; + package lace.Environ -- -- Models an operating system environment. -- is use posix.Permissions; + function to_octal_Mode (Permissions : in Permission_Set) return String; + subtype Data is ada.Streams.Stream_Element_Array; + Error : exception; end lace.Environ;