Skip to content

Commit

Permalink
Interpret environment entries as path parts (#1483)
Browse files Browse the repository at this point in the history
* Intepret environment values as paths

This is the likely intended behavior. Down the road we can have a way to have
literal values in these strings.

* Fixes for Windows brokenness
  • Loading branch information
mosteo authored Feb 26, 2024
1 parent 64f73f3 commit 2f53db7
Show file tree
Hide file tree
Showing 30 changed files with 272 additions and 59 deletions.
7 changes: 7 additions & 0 deletions doc/catalog-format-spec.md
Original file line number Diff line number Diff line change
Expand Up @@ -316,6 +316,10 @@ static, i.e. they cannot depend on the context.
PATH.append = "${DISTRIB_ROOT}/usr/bin"
```

Path fragments in this table must use portable format, that is, '/' for path
separation. Alire will take care of using the native separator when setting
these variables.

Predefined variables are provided by Alire and will be replaced in the
value:

Expand All @@ -325,6 +329,9 @@ static, i.e. they cannot depend on the context.
be the `msys2` installation directory (e.g.
`C:\Users\user_name\.cache\alire\msys2`).

The escaping `"\$"` can be used to prevent the expansion of a
dollar-bracketed expression.

Environment entries can use dynamic expressions:

```toml
Expand Down
21 changes: 20 additions & 1 deletion src/alire/alire-environment-formatting.adb
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

with Alire.OS_Lib;
with Alire.Platforms.Current;

package body Alire.Environment.Formatting is
Expand Down Expand Up @@ -81,6 +82,23 @@ package body Alire.Environment.Formatting is
end if;
end Replace;

---------------
-- To_Native --
---------------
-- Replace forward slashes with native slashes on Windows, unless they
-- are an escape sequence.
function To_Native (S : String) return String is
begin
case OS_Lib.Dir_Separator is
when '/' => return S;
when '\' => null;
when others => raise Unimplemented with
"Unknown OS with dir separator: " & OS_Lib.Dir_Separator;
end case;

return AAA.Strings.Replace (S, "/", "" & OS_Lib.Dir_Separator);
end To_Native;

Result : Unbounded_String := To_Unbounded_String (Value);
From : Natural := 1;
To : Natural;
Expand All @@ -107,7 +125,8 @@ package body Alire.Environment.Formatting is
From := 1;
end loop;

return To_String (Result);
-- For final usage, we use the native separator
return To_Native (+Result);
end Format;

end Alire.Environment.Formatting;
2 changes: 0 additions & 2 deletions src/alire/alire-os_lib-subprocess.adb
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,6 @@ with GNAT.OS_Lib;

package body Alire.OS_Lib.Subprocess is

use AAA.Strings;

function To_Argument_List
(Args : AAA.Strings.Vector)
return GNAT.OS_Lib.Argument_List_Access;
Expand Down
58 changes: 58 additions & 0 deletions src/alire/alire-os_lib.ads
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
private with AAA.Strings;

with GNATCOLL.OS.Constants;

package Alire.OS_Lib with Preelaborate is

function "/" (L, R : String) return String;
Expand All @@ -20,4 +24,58 @@ package Alire.OS_Lib with Preelaborate is
-- Return the location of an executable if found on PATH, or "" otherwise.
-- On Windows, no need to append ".exe" as it will be found without it.

Forbidden_Dir_Separator : constant Character :=
(case GNATCOLL.OS.Constants.Dir_Sep is
when '/' => '\',
when '\' => '/',
when others =>
raise Unimplemented
with "Unknown dir separator");

-- For things that may contain path fragments but are not proper paths

Dir_Separator : Character renames GNATCOLL.OS.Constants.Dir_Sep;

subtype Native_Path_Like is String
with Dynamic_Predicate =>
(for all Char of Native_Path_Like => Char /= Forbidden_Dir_Separator)
or else raise Ada.Assertions.Assertion_Error
with "Not a native-path-like: " & Native_Path_Like;

subtype Portable_Path_Like is String
with Dynamic_Predicate =>
(for all Char of Portable_Path_Like => Char /= '\')
or else raise Ada.Assertions.Assertion_Error
with "Not a portable-path-like: " & Portable_Path_Like;

function To_Portable (Path : Any_Path) return Portable_Path_Like;
-- Path is Any_Path and not Native_Path_Like because some Windows native
-- programs return mixed style paths such as "C:/blah/blah".

function To_Native (Path : Portable_Path_Like) return Native_Path_Like;

private

use AAA.Strings;
use all type GNATCOLL.OS.OS_Type;

----------------------
-- To_Portable_Like --
----------------------

function To_Portable (Path : Any_Path)
return Portable_Path_Like
is (case GNATCOLL.OS.Constants.OS is
when MacOS | Unix => Path,
when Windows => Replace (Path, "\", "/"));

--------------------
-- To_Native_Like --
--------------------

function To_Native (Path : Portable_Path_Like) return Native_Path_Like
is (case GNATCOLL.OS.Constants.OS is
when MacOS | Unix => Path,
when Windows => Replace (String (Path), "/", "\"));

end Alire.OS_Lib;
24 changes: 22 additions & 2 deletions src/alire/alire-properties-environment.adb
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,24 @@ package body Alire.Properties.Environment is
use type Conditional.Properties;
use TOML;
Env : TOML_Value;

----------------
-- Path_Check --
----------------

procedure Path_Check (Var, S : String) is
begin
-- We expect something resembling a portable path, but we admit "\$"
-- as an escape sequence.
for I in S'Range loop
if S (I) = '\' and then (I = S'Last or else S (I + 1) /= '$') then
Raise_Checked_Error
(Var & ": forbidden '\' character in environment path; "
& "use '/' instead");
end if;
end loop;
end Path_Check;

begin
if From.Unwrap.Kind /= TOML_Table then
From.Checked_Error
Expand All @@ -87,7 +105,7 @@ package body Alire.Properties.Environment is
for Name of Env.Keys loop
declare
Var : Variable; -- The env. var. being parsed
Val : TOML_Value; -- The env. var. value
Val : TOML_Value; -- The env. var. action. value
begin
Var.Name := Name;

Expand All @@ -109,8 +127,10 @@ package body Alire.Properties.Environment is
Actions_Suggestion (Action_Image));
end;

-- Value (already type checked in previous pop)
-- We consider values as possibly containing paths, so we check
-- that path separators are portable

Path_Check (+Name, Val.As_String);
Var.Value := +Val.As_String;

-- Pop entry to avoid upper "unexpected key" errors
Expand Down
2 changes: 1 addition & 1 deletion src/alire/alire-properties-environment.ads
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ private
type Variable is new Property with record
Action : Actions;
Name : UString;
Value : UString;
Value : UString; -- Value with portable path separators
end record;

end Alire.Properties.Environment;
21 changes: 9 additions & 12 deletions src/alire/alire-publish.adb
Original file line number Diff line number Diff line change
Expand Up @@ -25,15 +25,14 @@ with Alire.TOML_Index;
with Alire.TOML_Keys;
with Alire.TOML_Load;
with Alire.User_Pins.Maps;
with Alire.Utils.Tools;
with Alire.Utils.TTY;
with Alire.Utils.User_Input.Query_Config;
with Alire.VCSs.Git;
with Alire.VFS;

with CLIC.User_Input;

with GNATCOLL.OS.Constants;

with Semantic_Versioning;

with TOML.File_IO;
Expand Down Expand Up @@ -631,12 +630,10 @@ package body Alire.Publish is
With_Extension => False);
Git : constant VCSs.Git.VCS := VCSs.Git.Handler;
Is_Repo : constant Boolean := Git.Is_Repository (Base_Path (Context));
Archive : constant Relative_Path :=
Target_Dir
/ (Milestone
& (if Is_Repo
then ".tgz"
else ".tbz2"));
Archive : constant Relative_Path := Target_Dir / (Milestone & ".tgz");
-- We used to use tbz2 for locally tar'ed files, but that has an implicit
-- dependency on bzip2 that we are not managing yet, so for now we err on
-- the safe side of built-in tar gzip capabilities.

-----------------
-- Git_Archive --
Expand Down Expand Up @@ -669,14 +666,15 @@ package body Alire.Publish is
OS_Lib.Subprocess.Checked_Spawn
("tar",
Empty_Vector
& "cfj"
& "cfz"
& Archive -- Destination file at alire/archives/crate-version.tbz2

& String'("--exclude=./alire")
-- Exclude top-level alire folder, before applying prefix

-- exclude .git and the like, with workaround for macOS bsd tar
& (if GNATCOLL.OS.Constants.OS in GNATCOLL.OS.MacOS
-- exclude .git and the like, with workaround for bsdtar used by
-- macOS and Windows without MSYS2
& (if Utils.Tools.Is_BSD_Tar
then Empty_Vector
& "--exclude=./.git"
& "--exclude=./.hg"
Expand Down Expand Up @@ -1096,7 +1094,6 @@ package body Alire.Publish is
then Ada.Directories.Full_Name (Path)
else Ada.Directories.Full_Name (Root.Value.Path));
begin

if not Git.Is_Repository (Root_Path) then
Git_Error ("no git repository found", Root_Path);
end if;
Expand Down
24 changes: 19 additions & 5 deletions src/alire/alire-toml_adapters.adb
Original file line number Diff line number Diff line change
Expand Up @@ -263,8 +263,8 @@ package body Alire.TOML_Adapters is
----------------------

function Pop_Single_Table (Queue : Key_Queue;
Value : out TOML.TOML_Value;
Kind : TOML.Any_Value_Kind) return String
Value : out TOML.TOML_Value)
return String
is
use TOML;
begin
Expand All @@ -280,14 +280,28 @@ package body Alire.TOML_Adapters is

Value := Queue.Value.Get (Queue.Value.Keys (1));

return Key : constant String := +Queue.Value.Keys (1) do
Queue.Value.Unset (Queue.Value.Keys (1));
end return;
end Pop_Single_Table;

----------------------
-- Pop_Single_Table --
----------------------

function Pop_Single_Table (Queue : Key_Queue;
Value : out TOML.TOML_Value;
Kind : TOML.Any_Value_Kind) return String
is
use TOML;
Key : constant String := Queue.Pop_Single_Table (Value);
begin
if Value.Kind /= Kind then
Queue.Checked_Error ("expected a single entry of type "
& Kind'Img & ", but got a " & Value.Kind'Img);
end if;

return Key : constant String := +Queue.Value.Keys (1) do
Queue.Value.Unset (Queue.Value.Keys (1));
end return;
return Key;
end Pop_Single_Table;

-----------------------
Expand Down
12 changes: 10 additions & 2 deletions src/alire/alire-toml_adapters.ads
Original file line number Diff line number Diff line change
Expand Up @@ -98,8 +98,16 @@ package Alire.TOML_Adapters with Preelaborate is
-- intended use is to process keys beginning with "case(" in the table.

function Pop_Single_Table (Queue : Key_Queue;
Value : out TOML.TOML_Value;
Kind : TOML.Any_Value_Kind) return String;
Value : out TOML.TOML_Value)
return String;
-- For constructions like [parent.child.grandchild], where only one child
-- is allowed. Child is returned as String, and Value is set to granchild.
-- Raises Checked_Error if Queue is not a table, or it doesn't contain
-- exactly one key.

function Pop_Single_Table (Queue : Key_Queue;
Value : out TOML.TOML_Value;
Kind : TOML.Any_Value_Kind) return String;
-- For constructions like [parent.child.grandchild], where we known that
-- only one child can exist. Will raise Checked_Error if any of these
-- happens: Queue is not a table; Queue doesn't have exactly one key; Value
Expand Down
16 changes: 16 additions & 0 deletions src/alire/alire-utils-tools.adb
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
with AAA.Strings;

with Alire.OS_Lib.Subprocess; use Alire.OS_Lib.Subprocess;
with Alire.OS_Lib;
with Alire.Platforms.Current;
Expand Down Expand Up @@ -157,4 +159,18 @@ package body Alire.Utils.Tools is
Install_From_Distrib (Tool, Fail);
end Check_Tool;

----------------
-- Is_BSD_Tar --
----------------

function Is_BSD_Tar return Boolean is
use AAA.Strings;
begin
return Contains
(To_Lower_Case
(Checked_Spawn_And_Capture
("tar", To_Vector ("--version")).Flatten),
"bsdtar");
end Is_BSD_Tar;

end Alire.Utils.Tools;
4 changes: 4 additions & 0 deletions src/alire/alire-utils-tools.ads
Original file line number Diff line number Diff line change
Expand Up @@ -18,4 +18,8 @@ package Alire.Utils.Tools is
-- Check if a required executable tool is available in PATH.
-- If not, try to install it. If unable and Fail, abort, otherwise return

function Is_BSD_Tar return Boolean
with Pre => Available (Tar);
-- Say if the tar in PATH is the bsdtar variant, which lacks some features

end Alire.Utils.Tools;
15 changes: 0 additions & 15 deletions src/alire/alire-vfs.adb
Original file line number Diff line number Diff line change
Expand Up @@ -21,21 +21,6 @@ package body Alire.VFS is
end if;
end Attempt_Portable;

-----------------
-- To_Portable --
-----------------

function To_Portable (Path : Relative_Path) return Portable_Path
is
begin
case GNATCOLL.OS.Constants.OS is
when MacOS | Unix =>
return Portable_Path (Path);
when Windows =>
return Portable_Path (Replace (Path, "\", "/"));
end case;
end To_Portable;

--------------
-- Read_Dir --
--------------
Expand Down
Loading

0 comments on commit 2f53db7

Please sign in to comment.