Skip to content

Commit

Permalink
Improve origin URI recognition
Browse files Browse the repository at this point in the history 
- Consolidate a number of separate ad hoc tests for recognising URIs into Alire.URI.URI_Kind
- Add support for origin URLs with scheme "ssh://"
- Add bitbucket.org to the list of hosts recognised as git only
- Treat ".git/" suffix the same as ".git"
- Change publish command to raise errors on URLs with "file:" scheme (sidestepping a bug where the whole URL was treated as a relative path)
- Change various error messages
- Change handling of some obscure edge cases
  • Loading branch information
@Seb-MCaw
Seb-MCaw committed Aug 12, 2024
1 parent 493d0c1 commit 6ae4742
Show file tree
Hide file tree
Showing 33 changed files with 454 additions and 224 deletions.
8 changes: 7 additions & 1 deletion doc/catalog-format-spec.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -443,6 +443,12 @@ static, i.e. they cannot depend on the context.
the following fields:

- `url`: mandatory string which points to a source file or repository.
If it points to a repository, this should be apparent from the URL;
the prefixes `git+`, `hg+` or `svn+` can be prepended to the scheme
(e.g. `git+https://`) to make this explicit, though a `.git` suffix or
the hosts `github.com` or `gitlab.com` will also be recognised.
Origins should be publicly accessible (i.e. should not require
private ssh keys or other authentication).

- `hashes`: mandatory string array for source archives. An array
of "kind:digest" fields that specify a hash kind and its value. Kinds
Expand All @@ -462,7 +468,7 @@ static, i.e. they cannot depend on the context.
several crates from the same repository (sometimes referred to as a
*monorepo*).

- `binary`: optional (defauts to false) boolean used to design the origin
- `binary`: optional (defaults to false) boolean used to design the origin
as binary. Binary origins are not compiled and can optionally use dynamic
expressions to narrow down the platform to which they apply. An origin
using a dynamic expression must be tagged as binary; see the
Expand Down
2 changes: 1 addition & 1 deletion src/alire/alire-origins-deployers-source_archive.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -138,7 +138,7 @@ package body Alire.Origins.Deployers.Source_Archive is
-- linux also for local files, something funny is going on Windows which
-- is difficult to pinpoint.

if URI.Scheme (This.Base.Archive_URL) in URI.File_Schemes then
if URI.URI_Kind (This.Base.Archive_URL) in URI.Local_Other then
if not Dirs.Exists (Folder) then
Alire.Directories.Create_Tree (Folder);
end if;
Expand Down
2 changes: 1 addition & 1 deletion src/alire/alire-origins-tweaks.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ package body Alire.Origins.Tweaks is
URL : constant String := This.URL; -- Doesn't include #commit
begin
-- Check for "xxx+file://" or return as-is:
if URI.Scheme (URL) not in URI.File_Schemes then
if URI.URI_Kind (URL) not in URI.Local_URIs then
return This;
end if;

Expand Down
87 changes: 29 additions & 58 deletions src/alire/alire-origins.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -367,7 +367,7 @@ package body Alire.Origins is
return (Data => (Source_Archive,
Src_Archive =>
(URL =>
+(if URI.Scheme (URL) in URI.File_Schemes
+(if URI.URI_Kind (URL) in URI.Local_Other
then "file:" & Ada.Directories.Full_Name
(URI.Local_Path (URL))
else URL),
Expand All @@ -377,74 +377,38 @@ package body Alire.Origins is
Hashes => <>)));
end New_Source_Archive;

-----------------
-- From_String --
-----------------

function From_String (Image : String) return Origin is
Scheme : constant URI.Schemes := URI.Scheme (Image);
begin
case Scheme is
when URI.File_Schemes =>
return New_Filesystem (URI.Local_Path (Image));
when URI.HTTP =>
return New_Source_Archive (Image);
when others =>
Raise_Checked_Error ("Unsupported URL scheme: " & Image);
end case;
end From_String;

-------------
-- New_VCS --
-------------

function New_VCS (URL : Alire.URL;
Commit : String;
Subdir : Relative_Path := "") return Origin is
use AAA.Strings;
use all type URI.Schemes;
Scheme : constant URI.Schemes := URI.Scheme (URL);
VCS_URL : constant String :=
(if Contains (URL, "+file://") then
Tail (URL, '+') -- strip the VCS proto only
elsif Contains (URL, "+file:") then
Tail (URL, ':') -- Remove file: w.o. // that confuses git
elsif Scheme = URI.Pure_Git then
URL
elsif Scheme in URI.VCS_Schemes then
Tail (URL, '+') -- remove prefix vcs+
elsif Scheme in URI.HTTP then -- A plain URL... check VCS
(if Has_Suffix (To_Lower_Case (URL), ".git")
then URL
elsif VCSs.Git.Known_Transformable_Hosts.Contains
(URI.Authority (URL))
then URL & ".git"
else raise Checked_Error with
"ambiguous VCS URL: " & URL)
else
raise Checked_Error with "unknown VCS URL: " & URL);
URL_Kind : constant URI.URI_Kinds := URI.URI_Kind (URL);
VCS_URL : constant String := VCSs.Repo_And_Commit (URL);

begin
case Scheme is
when Pure_Git | Git | HTTP =>
case URL_Kind is
when URI.Git_URIs =>
if Commit'Length /= Git_Commit'Length then
Raise_Checked_Error
("invalid git commit id, " &
"40 digits hexadecimal expected");
end if;
return New_Git (VCS_URL, Commit, Subdir);
when Hg =>
when URI.Hg_URIs =>
if Commit'Length /= Hg_Commit'Length then
Raise_Checked_Error
("invalid mercurial commit id, " &
"40 digits hexadecimal expected");
end if;
return New_Hg (VCS_URL, Commit, Subdir);
when SVN =>
when URI.SVN_URIs =>
return New_SVN (VCS_URL, Commit, Subdir);
when URI.Public_Other | URI.SSH_Other =>
Raise_Checked_Error ("ambiguous VCS URL: " & URL);
when others =>
Raise_Checked_Error ("Expected a VCS origin but got scheme: "
& Scheme'Image);
Raise_Checked_Error ("unknown VCS URL: " & URL);
end case;
end New_VCS;

Expand Down Expand Up @@ -555,7 +519,7 @@ package body Alire.Origins is
is

use TOML;
use all type URI.Schemes;
use all type URI.URI_Kinds;
Table : constant TOML_Adapters.Key_Queue :=
From.Descend (From.Checked_Pop (Keys.Origin, TOML_Table),
Context => Keys.Origin);
Expand Down Expand Up @@ -603,22 +567,22 @@ package body Alire.Origins is
-- Regular static loading of other origin kinds

declare
URL : constant String :=
URL : constant String :=
Table.Checked_Pop (Keys.URL, TOML_String).As_String;
Scheme : constant URI.Schemes := URI.Scheme (URL);
Hashed : constant Boolean := Table.Unwrap.Has (Keys.Hashes);
URL_Kind : constant URI.URI_Kinds := URI.URI_Kind (URL);
Hashed : constant Boolean := Table.Unwrap.Has (Keys.Hashes);
begin
case Scheme is
when External =>
case URL_Kind is
when External =>
This := New_External (URI.Path (URL));

when URI.File_Schemes =>
when URI.Local_Other =>
if URI.Local_Path (URL) = "" then
From.Checked_Error ("empty path given in local origin");
end if;
This := New_Filesystem (URI.Local_Path (URL));

when URI.VCS_Schemes =>
when URI.VCS_URIs =>
declare
Commit : constant String := Table.Checked_Pop
(Keys.Commit, TOML_String).As_String;
Expand All @@ -634,7 +598,7 @@ package body Alire.Origins is
Subdir => VFS.To_Native (Portable_Path (Subdir)));
end;

when HTTP =>
when Public_Other =>
-- Reinsert the URL so we can reuse the dynamic archive loader:
Table.Unwrap.Set (Keys.URL, Create_String (URL));

Expand All @@ -646,10 +610,16 @@ package body Alire.Origins is
Table.Unwrap,
Context => "source archive")),
Hashes => <>));
when System =>

when SSH_Other =>
From.Checked_Error ("Pure 'ssh://' URLs are not valid crate "
& "origins. You may want git+" & URL
& " instead.");

when System =>
This := New_System (URI.Path (URL));

when Unknown =>
when Unknown =>
From.Checked_Error ("unsupported scheme in URL: " & URL);
end case;

Expand Down Expand Up @@ -768,9 +738,10 @@ package body Alire.Origins is
Table.Set (Keys.URL, +("file:" & This.Path));

when VCS_Kinds =>
-- Restore any prefixes which were stripped by New_VCS
Table.Set (Keys.URL,
+(Prefixes (This.Kind).all
& (if URI.Scheme (This.URL) in URI.None
& (if URI.URI_Kind (This.URL) in URI.Bare_Path
-- not needed for remote repos, but for testing
-- ones used locally:
then "file:"
Expand Down
10 changes: 2 additions & 8 deletions src/alire/alire-origins.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -159,8 +159,8 @@ package Alire.Origins is
function New_VCS (URL : Alire.URL;
Commit : String;
Subdir : Relative_Path := "") return Origin;
-- Attempt to identify an origin kind from the transport (git+https). If no
-- VCS specified, look for ".git" extension.
-- Determine whether URL looks like git, Hg or SVN, and construct an origin
-- accordingly. Raises Checked_Error if not recognised as any VCS.

Unknown_Source_Archive_Name_Error : exception;

Expand All @@ -187,12 +187,6 @@ package Alire.Origins is
procedure Add_Hash (This : in out Origin;
Hash : Hashes.Any_Hash);

function From_String (Image : String) return Origin with
Post => From_String'Result.Kind in Filesystem | Source_Archive;
-- Parse a string and dispatch to the appropriate constructor. This
-- function can be used to retrieve unhashed origins too (precisely
-- for hashing).

overriding
function From_TOML (This : in out Origin;
From : TOML_Adapters.Key_Queue)
Expand Down
91 changes: 39 additions & 52 deletions src/alire/alire-publish.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -752,7 +752,7 @@ package body Alire.Publish is

function Get_Default (Remote_URL : String)
return Answer_Kind
is (if Force or else URI.Scheme (Remote_URL) in URI.HTTP
is (if Force or else URI.URI_Kind (Remote_URL) in URI.Public_Other
then Yes
else No);

Expand Down Expand Up @@ -865,16 +865,13 @@ package body Alire.Publish is

-- Ensure the origin is remote

if URI.Scheme (URL) not in URI.HTTP then
-- A git@ URL is private to the user and should not be used for
-- packaging:
if AAA.Strings.Has_Prefix (URL, "git@") then
Raise_Checked_Error
("The origin cannot use a private git remote: " & URL);
end if;

-- Otherwise we assume this is a local path

if URI.URI_Kind (URL) in URI.Unknown then
Raise_Checked_Error ("Unsupported scheme: " & URL);
elsif URI.URI_Kind (URL) in URI.Private_URIs then
-- A private URL should not be used for packaging
Raise_Checked_Error
("The origin cannot use a private remote: " & URL);
elsif URI.URI_Kind (URL) not in URI.Public_URIs then
Recoverable_User_Error
("The origin must be a definitive remote location, but is " & URL);
-- For testing we may want to allow local URLs, or may be for
Expand All @@ -889,10 +886,7 @@ package body Alire.Publish is
-- a local repository.

if (Force and then
URI.Scheme (URL) in URI.File_Schemes | URI.Unknown)
-- We are forcing, so we accept an unknown scheme (this happens
-- for local file on Windows, where drive letters are interpreted
-- as the scheme).
URI.URI_Kind (URL) in URI.Local_URIs)
or else
Is_Trusted (URL)
then
Expand Down Expand Up @@ -1143,6 +1137,9 @@ package body Alire.Publish is
& TTY.Emph (Revision));
end if;

-- Call Remote_Origin, ensuring that a URL referring to a
-- local path has a "file:" (or "git+file:") scheme and no
-- added ".git" suffix.
declare
Raw_URL : constant String :=
Git.Fetch_URL
Expand All @@ -1151,40 +1148,25 @@ package body Alire.Publish is
-- The one reported by the repo, in its public form

Fetch_URL : constant String :=
-- With an added ".git", if it hadn't one. Not usable in local
-- filesystem.
Raw_URL
& (if Has_Suffix (To_Lower_Case (Raw_URL), ".git")
then ""
else ".git");
-- With an added ".git", if there isn't one already and the URL
-- isn't a local file path.
Raw_URL
& (if Has_Suffix (To_Lower_Case (Raw_URL), ".git")
or else URI.URI_Kind (Raw_URL) in URI.Local_URIs
then ""
else ".git");
begin
-- To allow this call to succeed with local tests, we check
-- here. For a regular repository we will already have an HTTP
-- transport. A GIT transport is not wanted, because that one
-- requires the owner keys.
case URI.Scheme (Fetch_URL) is
when URI.VCS_Schemes =>
Raise_Checked_Error
("The remote URL seems to require repository ownership: "
& Fetch_URL);
when URI.None | URI.Unknown =>
Publish.Remote_Origin (URL => "git+file:" & Raw_URL,
Commit => Commit,
Subdir => +Subdir,
Options => Options);
when URI.File =>
Publish.Remote_Origin (URL => Raw_URL,
if URI.URI_Kind (Fetch_URL) in URI.Bare_Path then
Publish.Remote_Origin (URL => "git+file:" & Fetch_URL,
Commit => Commit,
Subdir => +Subdir,
Options => Options);
when URI.HTTP =>
else
Publish.Remote_Origin (URL => Fetch_URL,
Commit => Commit,
Subdir => +Subdir,
Options => Options);
when others =>
Raise_Checked_Error ("Unsupported scheme: " & Fetch_URL);
end case;
end if;
end;
end;
end;
Expand All @@ -1202,9 +1184,7 @@ package body Alire.Publish is
begin
-- Preliminary argument checks

if Has_Suffix (AAA.Strings.To_Lower_Case (URL), ".git") and then
Commit = ""
then
if URI.URI_Kind (URL) in URI.VCS_URIs and then Commit = "" then
Raise_Checked_Error
("URL seems to point to a repository, but no commit was provided.");
end if;
Expand All @@ -1215,6 +1195,17 @@ package body Alire.Publish is
Raise_Checked_Error ("Cannot publish a nested crate from an archive");
end if;

-- Check for obviously invalid url

if URI.URI_Kind (URL) in URI.SSH_Other then
Raise_Checked_Error ("'ssh://' URLs are not valid crate origins. You "
& "may want git+" & URL & " instead.");
end if;
if URI.URI_Kind (URL) in URI.External | URI.System | URI.Unknown
then
Raise_Checked_Error ("Unsupported scheme: " & URL);
end if;

-- Create origin, which will do more checks, and proceed

declare
Expand All @@ -1226,15 +1217,11 @@ package body Alire.Publish is
(if Commit /= "" then
Origins.New_VCS (URL, Commit, Subdir)

-- without commit
elsif URI.Scheme (URL) in URI.VCS_Schemes or else
VCSs.Git.Known_Transformable_Hosts.Contains
(URI.Authority_Without_Credentials (URL))
then
raise Checked_Error with
"A commit id is mandatory for a VCS origin"

-- plain archive
--
-- From the preliminary argument checks above, the
-- absence of a commit implies URL doesn't look like
-- a VCS.
else
Origins.New_Source_Archive (URL)),

Expand Down
Loading

0 comments on commit 6ae4742

Please sign in to comment.