lace.environ.*: Cosmetics.
This commit is contained in:
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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);
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user