Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 9 additions & 28 deletions apps/expert/lib/expert/engine_node.ex
Original file line number Diff line number Diff line change
Expand Up @@ -255,32 +255,13 @@ defmodule Expert.EngineNode do

build_engine_script = Path.join(expert_priv, "build_engine.exs")

opts =
[
args: [
build_engine_script,
"--source-path",
engine_source,
"--vsn",
Expert.vsn()
],
env: Expert.Port.ensure_charlists(env),
cd: Project.root_path(project)
]

{launcher, opts} =
if Forge.OS.windows?() do
{elixir, opts}
else
launcher = Expert.Port.path()

opts =
Keyword.update(opts, :args, [elixir], fn old_args ->
[elixir | Enum.map(old_args, &to_string/1)]
end)

{launcher, opts}
end
args = [
build_engine_script,
"--source-path",
engine_source,
"--vsn",
Expert.vsn()
]

Expert.log_info(lsp, project, "Finding or building engine")

Expand All @@ -291,8 +272,8 @@ defmodule Expert.EngineNode do
fn ->
Process.flag(:trap_exit, true)

{:spawn_executable, launcher}
|> Port.open([:stderr_to_stdout | opts])
elixir
|> Expert.Port.open_elixir_with_env(env, args: args, cd: Project.root_path(project))
|> wait_for_engine()
end
|> Task.async()
Expand Down
175 changes: 112 additions & 63 deletions apps/expert/lib/expert/port.ex
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
defmodule Expert.Port do
@moduledoc """
Utilities for launching ports in the context of a project
Utilities for launching ports in the context of a project.
"""

alias Forge.Project
Expand Down Expand Up @@ -33,10 +33,21 @@ defmodule Expert.Port do
environment_variables ++ env
end)

open(project, elixir_executable, opts)
open_executable(elixir_executable, opts)
end
end

@doc """
Returns the elixir executable path and environment for a project.

Returns `{:ok, elixir_path, env}` where:
- `elixir_path` is a charlist path to the elixir executable
- `env` is a list of `{key, value}` tuples for the environment

Returns `{:error, :no_elixir, reason}` if no elixir executable can be found.
"""
@spec elixir_executable(Project.t()) ::
{:ok, charlist(), list()} | {:error, :no_elixir, String.t()}
def elixir_executable(%Project{} = project) do
case find_project_elixir(project) do
{:ok, _, _} = success ->
Expand All @@ -51,52 +62,94 @@ defmodule Expert.Port do
end
end

@doc """
Opens a port for elixir with the given executable and environment.

Use this when you already have the elixir path and env from `elixir_executable/1`
and need to customize the port options.

## Options

* `:args` - List of arguments to pass to the elixir executable
* `:cd` - Working directory for the port
* `:env` - Additional environment variables (merged with the provided env)

"""
@spec open_elixir_with_env(charlist(), list(), open_opts()) :: port()
def open_elixir_with_env(elixir_executable, env, opts) do
opts =
opts
|> Keyword.update(:env, env, fn additional_env -> env ++ additional_env end)

open_executable(elixir_executable, opts)
end

# --- Private Functions ---

defp find_project_elixir(%Project{} = project) do
if Forge.OS.windows?() do
# Remove the burrito binaries from PATH
path =
"PATH"
|> System.get_env()
|> String.split(";", parts: 2)
|> List.last()

case :os.find_executable(~c"elixir", to_charlist(path)) do
false ->
{:error, :no_elixir, "Couldn't find an elixir executable"}

elixir ->
env =
Enum.map(System.get_env(), fn
{"PATH", _path} -> {"PATH", path}
other -> other
end)

{:ok, elixir, env}
end
find_project_elixir_windows()
else
root_path = Project.root_path(project)
find_project_elixir_unix(project)
end
end

shell = System.get_env("SHELL")
path = path_env_at_directory(root_path, shell)
defp find_project_elixir_windows do
release_root =
:code.root_dir()
|> to_string()
|> String.downcase()
|> String.replace("/", "\\")

path =
"PATH"
|> System.get_env("")
|> String.split(";")
|> Enum.reject(fn entry ->
normalized = entry |> String.downcase() |> String.replace("/", "\\")
String.contains?(normalized, release_root)
end)
|> Enum.join(";")

case :os.find_executable(~c"elixir", to_charlist(path)) do
false ->
{:error, :no_elixir,
"Couldn't find an elixir executable for project at #{root_path}. Using shell at #{shell} with PATH=#{path}"}
case :os.find_executable(~c"elixir", to_charlist(path)) do
false ->
{:error, :no_elixir, "Couldn't find an elixir executable"}

elixir ->
env =
Enum.map(System.get_env(), fn
{"PATH", _path} -> {"PATH", path}
other -> other
end)
elixir ->
env =
System.get_env()
|> Enum.reject(fn {key, _} -> key == "ERLEXEC_DIR" end)
|> Enum.map(fn
{key, _path} when key in ["PATH", "Path"] -> {key, path}
other -> other
end)

{:ok, elixir, env}
end
end

{:ok, elixir, env}
end
defp find_project_elixir_unix(%Project{} = project) do
root_path = Project.root_path(project)

shell = System.get_env("SHELL")
path = path_env_at_directory(root_path, shell)

case :os.find_executable(~c"elixir", to_charlist(path)) do
false ->
{:error, :no_elixir,
"Couldn't find an elixir executable for project at #{root_path}. Using shell at #{shell} with PATH=#{path}"}

elixir ->
env =
Enum.map(System.get_env(), fn
{"PATH", _path} -> {"PATH", path}
other -> other
end)

{:ok, elixir, env}
end
end

# Fallback to using whatever elixir Expert was packaged with.
defp fallback_elixir do
case System.find_executable("elixir") do
nil ->
Expand All @@ -122,8 +175,6 @@ defmodule Expert.Port do

args =
case Path.basename(shell) do
# Ideally, it should contain the path to shell (e.g. `/usr/bin/fish`),
# but it might contain only the name of the shell (e.g. `fish`).
"fish" ->
# Fish uses space-separated PATH, so we use the built-in `string join` command
# to join the entries with colons and have a standard colon-separated PATH output
Expand Down Expand Up @@ -159,16 +210,9 @@ defmodule Expert.Port do
end
end

@doc """
Launches an executable in the project context via a port.
"""
def open(%Project{} = project, executable, opts) do
defp open_executable(executable, opts) do
{os_type, _} = Forge.OS.type()

opts =
opts
|> Keyword.put_new_lazy(:cd, fn -> Project.root_path(project) end)

opts =
if Keyword.has_key?(opts, :env) do
Keyword.update!(opts, :env, &ensure_charlists/1)
Expand All @@ -180,11 +224,27 @@ defmodule Expert.Port do
end

defp open_port(:win32, executable, opts) do
Port.open({:spawn_executable, executable}, [:stderr_to_stdout, :exit_status | opts])
executable_str = to_string(executable)

{launcher, opts} =
if String.ends_with?(executable_str, ".cmd") or String.ends_with?(executable_str, ".bat") do
cmd_exe = "cmd" |> System.find_executable() |> to_charlist()

opts =
Keyword.update(opts, :args, ["/c", executable_str], fn args ->
["/c", executable_str | args]
end)

{cmd_exe, [:hide | opts]}
else
{executable, opts}
end

Port.open({:spawn_executable, launcher}, [:stderr_to_stdout, :exit_status | opts])
end

defp open_port(:unix, executable, opts) do
{launcher, opts} = Keyword.pop_lazy(opts, :path, &path/0)
launcher = port_wrapper_path()

opts =
Keyword.update(opts, :args, [executable], fn old_args ->
Expand All @@ -194,14 +254,7 @@ defmodule Expert.Port do
Port.open({:spawn_executable, launcher}, [:stderr_to_stdout, :exit_status | opts])
end

@doc """
Provides the path of an executable to launch another erlang node via ports.
"""
def path do
path(Forge.OS.type())
end

def path({:unix, _}) do
defp port_wrapper_path do
with :non_existing <- :code.where_is_file(~c"port_wrapper.sh") do
:expert
|> :code.priv_dir()
Expand All @@ -211,11 +264,7 @@ defmodule Expert.Port do
|> to_string()
end

def path(os_tuple) do
raise ArgumentError, "Operating system #{inspect(os_tuple)} is not currently supported"
end

def ensure_charlists(environment_variables) do
defp ensure_charlists(environment_variables) do
Enum.map(environment_variables, fn {key, value} ->
# using to_string ensures nil values won't blow things up
erl_key = key |> to_string() |> String.to_charlist()
Expand Down
2 changes: 2 additions & 0 deletions apps/forge/lib/forge/namespace/file_sync.ex
Original file line number Diff line number Diff line change
Expand Up @@ -104,6 +104,8 @@ defmodule Forge.Namespace.FileSync do
end

defp find_files(directory) do
directory = Forge.OS.normalize_path(directory)

[directory, "**", "*"]
|> Path.join()
|> Path.wildcard()
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ defmodule Forge.Namespace.Transform.AppDirectories do
end

defp find_app_directories(base_directory) do
base_directory = Forge.OS.normalize_path(base_directory)
app_names = Mix.Tasks.Namespace.app_names()
app_globs = Enum.join(app_names, "*,")

Expand Down
1 change: 1 addition & 0 deletions apps/forge/lib/forge/namespace/transform/apps.ex
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ defmodule Forge.Namespace.Transform.Apps do
end

defp find_app_files(base_directory) do
base_directory = Forge.OS.normalize_path(base_directory)
app_files_glob = Enum.join(Mix.Tasks.Namespace.app_names(), ",")

[base_directory, "**", "{#{app_files_glob}}.app"]
Expand Down
3 changes: 3 additions & 0 deletions apps/forge/lib/forge/namespace/transform/beams.ex
Original file line number Diff line number Diff line change
Expand Up @@ -77,12 +77,15 @@ defmodule Forge.Namespace.Transform.Beams do
end

defp find_consolidated_beams(base_directory) do
base_directory = Forge.OS.normalize_path(base_directory)

[base_directory, "releases", "**", "consolidated", "*.beam"]
|> Path.join()
|> Path.wildcard()
end

defp find_app_beams(base_directory) do
base_directory = Forge.OS.normalize_path(base_directory)
namespaced_apps = Enum.join(Mix.Tasks.Namespace.app_names(), ",")
apps_glob = "{#{namespaced_apps}}*"

Expand Down
2 changes: 2 additions & 0 deletions apps/forge/lib/forge/namespace/transform/boots.ex
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,8 @@ defmodule Forge.Namespace.Transform.Boots do
end

defp find_boot_files(base_directory) do
base_directory = Forge.OS.normalize_path(base_directory)

[base_directory, "**", "*.script"]
|> Path.join()
|> Path.wildcard()
Expand Down
2 changes: 2 additions & 0 deletions apps/forge/lib/forge/namespace/transform/configs.ex
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
defmodule Forge.Namespace.Transform.Configs do
def apply_to_all(base_directory) do
base_directory = Forge.OS.normalize_path(base_directory)

base_directory
|> Path.join("**/runtime.exs")
|> Path.wildcard()
Expand Down
1 change: 1 addition & 0 deletions apps/forge/lib/forge/namespace/transform/scripts.ex
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ defmodule Forge.Namespace.Transform.Scripts do

@script_names ~w(start.script start_clean.script expert.rel)
defp find_scripts(base_directory) do
base_directory = Forge.OS.normalize_path(base_directory)
scripts_glob = "{" <> Enum.join(@script_names, ",") <> "}"

[base_directory, "releases", "**", scripts_glob]
Expand Down
12 changes: 12 additions & 0 deletions apps/forge/lib/forge/os.ex
Original file line number Diff line number Diff line change
Expand Up @@ -7,4 +7,16 @@ defmodule Forge.OS do
def type do
:os.type()
end

@doc """
Normalizes a path to use forward slashes consistently.

On Windows, Path.wildcard/1 has issues with mixed separator paths
(e.g., "C:\\Users\\...\\Temp/briefly-.../lib/..."). This function
ensures paths use forward slashes throughout, which works correctly
with Path.wildcard on all platforms.
"""
def normalize_path(path) when is_binary(path) do
String.replace(path, "\\", "/")
end
end
Loading