rebar3/bootstrap

#!/usr/bin/env escript
%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*-
%% ex: ft=erlang ts=4 sw=4 et


main(_Args) ->
    application:start(crypto),
    application:start(asn1),
    application:start(public_key),
    application:start(ssl),
    inets:start(),

    %% Fetch and build deps required to build rebar3
    BaseDeps = [{providers, []}
               ,{getopt, []}
               ,{erlware_commons, ["ec_dictionary.erl", "ec_vsn.erl"]}],
    Deps = get_deps(),
    [fetch_and_compile(Dep, Deps) || Dep <- BaseDeps],

    %% Build rebar3 modules with compile:file
    bootstrap_rebar3(),

    %% Build rebar.app from rebar.app.src
    {ok, App} = rebar_app_info:new(rebar, "3.0.0", filename:absname("_build/default/lib/rebar/")),
    rebar_otp_app:compile(rebar_state:new(), App),

    %% Because we are compiling files that are loaded already we want to silence
    %% not_purged errors in rebar_erlc_compiler:opts_changed/1
    error_logger:tty(false),

    setup_env(),
    os:putenv("REBAR_PROFILE", "bootstrap"),
    rebar3:run(["update"]),
    {ok, State} = rebar3:run(["compile"]),
    reset_env(),
    os:putenv("REBAR_PROFILE", ""),

    DepsPaths = rebar_state:code_paths(State, all_deps),
    code:add_pathsa(DepsPaths),

    rebar3:run(["clean", "-a"]),
    rebar3:run(["escriptize"]),

    %% Done with compile, can turn back on error logger
    error_logger:tty(true),

    %% Finally, update executable perms for our script on *nix,
    %%  or write out script files on win32.
    ec_file:copy("_build/default/bin/rebar3", "./rebar3"),
    case os:type() of
        {unix,_} ->
            [] = os:cmd("chmod u+x rebar3"),
            ok;
        {win32,_} ->
            write_windows_scripts(),
            ok;
        _ ->
            ok
    end.

fetch_and_compile({Name, ErlFirstFiles}, Deps) ->
    {Name, _, Repo} = lists:keyfind(Name, 1, Deps),
    ok = fetch(Repo, Name),
    compile(Name, ErlFirstFiles).

fetch({pkg, Name, Vsn}, App) ->
    Dir = filename:join([filename:absname("_build/default/lib/"), App]),
    CDN = "https://s3.amazonaws.com/s3.hex.pm/tarballs",
    Package = binary_to_list(<<Name/binary, "-", Vsn/binary, ".tar">>),
    Url = string:join([CDN, Package], "/"),
    case request(Url) of
        {ok, Binary} ->
            {ok, Contents} = extract(Binary),
            ok = erl_tar:extract({binary, Contents}, [{cwd, Dir}, compressed]);
        _ ->
            io:format("Error: Unable to fetch package ~p ~p~n", [Name, Vsn])
    end.

extract(Binary) ->
    {ok, Files} = erl_tar:extract({binary, Binary}, [memory]),
    {"contents.tar.gz", Contents} = lists:keyfind("contents.tar.gz", 1, Files),
    {ok, Contents}.

request(Url) ->
    setHttpcOptions(),
    case httpc:request(get, {Url, []},
                       [{relaxed, true}],
                       [{body_format, binary}]) of
        {ok, {{_Version, 200, _Reason}, _Headers, Body}} ->
            {ok, Body};
        Error ->
            Error
    end.

setHttpcOptions() ->
    %% Get http_proxy and https_proxy environment variables
    case os:getenv("http_proxy") of
        false ->
            Http = "";
        Http ->
            Http
    end,
    case os:getenv("https_proxy") of
        false ->
            Https = "";
        Https ->
            Https
    end,

    %% Parse the variables to extract host and port
    Opts = [],
    case http_uri:parse(Http) of
        {ok,{_, [], Host, Port, _, []}} ->
            Opts1 = Opts ++ [{proxy, {{Host, Port}, []}}];
        {error, _} ->
            Opts1 = Opts
    end,

    case http_uri:parse(Https) of
        {ok,{_, [], Host2, Port2, _, []}} ->
            Opts2 = Opts1 ++ [{https_proxy, {{Host2, Port2}, []}}];
        {error, _} ->
            Opts2 = Opts1
    end,

    io:format("Opts: ~p~n", [Opts2]),

    case Opts2 of
        [] ->
            ok;
        _ ->
            httpc:set_options(Opts2),
            ok
    end.

compile(App, FirstFiles) ->
    Dir = filename:join(filename:absname("_build/default/lib/"), App),
    filelib:ensure_dir(filename:join([Dir, "ebin", "dummy.beam"])),
    code:add_path(filename:join(Dir, "ebin")),
    FirstFilesPaths = [filename:join([Dir, "src", Module]) || Module <- FirstFiles],
    Sources = FirstFilesPaths ++ filelib:wildcard(filename:join([Dir, "src", "*.erl"])),
    [compile_file(X, [{i, filename:join(Dir, "include")}
                     ,debug_info
                     ,{outdir,  filename:join(Dir, "ebin")}
                     ,return | additional_defines()]) || X <- Sources].

compile_file(File, Opts) ->
    case compile:file(File, Opts) of
        {ok, _Mod} ->
            ok;
        {ok, _Mod, []} ->
            ok;
        {ok, _Mod, Ws} ->
            io:format("~s~n", [format_warnings(File, Ws)]),
            halt(1);
        {error, Es, Ws} ->
            io:format("~s ~s~n", [format_errors(File, Es), format_warnings(File, Ws)]),
            halt(1)
    end.

bootstrap_rebar3() ->
    filelib:ensure_dir("_build/default/lib/rebar/ebin/dummy.beam"),
    code:add_path("_build/default/lib/rebar/ebin/"),
    ok = symlink_or_copy(filename:absname("src"),
                         filename:absname("_build/default/lib/rebar/src")),
    Sources = ["src/rebar_resource.erl" | filelib:wildcard("src/*.erl")],
    [compile_file(X, [{outdir, "_build/default/lib/rebar/ebin/"}
                     ,return | additional_defines()]) || X <- Sources],
    code:add_patha(filename:absname("_build/default/lib/rebar/ebin")).

%%rebar.hrl
-define(FMT(Str, Args), lists:flatten(io_lib:format(Str, Args))).
%%/rebar.hrl
%%rebar_file_utils
symlink_or_copy(Source, Target) ->
    Link = case os:type() of
               {win32, _} ->
                   Source;
               _ ->
                   make_relative_path(Source, Target)
           end,
    case file:make_symlink(Link, Target) of
        ok ->
            ok;
        {error, eexist} ->
            ok;
        {error, _} ->
            cp_r([Source], Target)
    end.

make_relative_path(Source, Target) ->
    do_make_relative_path(filename:split(Source), filename:split(Target)).

do_make_relative_path([H|T1], [H|T2]) ->
    do_make_relative_path(T1, T2);
do_make_relative_path(Source, Target) ->
    Base = lists:duplicate(max(length(Target) - 1, 0), ".."),
    filename:join(Base ++ Source).

cp_r([], _Dest) ->
    ok;
cp_r(Sources, Dest) ->
    case os:type() of
        {unix, _} ->
            EscSources = [escape_path(Src) || Src <- Sources],
            SourceStr = string:join(EscSources, " "),
            os:cmd(?FMT("cp -R ~s \"~s\"", [SourceStr, Dest])),
            ok;
        {win32, _} ->
            lists:foreach(fun(Src) -> ok = cp_r_win32(Src,Dest) end, Sources),
            ok
    end.

xcopy_win32(Source,Dest)->
    R = os:cmd(?FMT("xcopy \"~s\" \"~s\" /q /y /e 2> nul",
                     [filename:nativename(Source), filename:nativename(Dest)])),
    case length(R) > 0 of
        %% when xcopy fails, stdout is empty and and error message is printed
        %% to stderr (which is redirected to nul)
        true -> ok;
        false ->
            {error, lists:flatten(
                      io_lib:format("Failed to xcopy from ~s to ~s~n",
                                    [Source, Dest]))}
    end.

cp_r_win32({true, SourceDir}, {true, DestDir}) ->
    %% from directory to directory
    SourceBase = filename:basename(SourceDir),
    ok = case file:make_dir(filename:join(DestDir, SourceBase)) of
             {error, eexist} -> ok;
             Other -> Other
         end,
    ok = xcopy_win32(SourceDir, filename:join(DestDir, SourceBase));
cp_r_win32({false, Source} = S,{true, DestDir}) ->
    %% from file to directory
    cp_r_win32(S, {false, filename:join(DestDir, filename:basename(Source))});
cp_r_win32({false, Source},{false, Dest}) ->
    %% from file to file
    {ok,_} = file:copy(Source, Dest),
    ok;
cp_r_win32({true, SourceDir}, {false, DestDir}) ->
    case filelib:is_regular(DestDir) of
        true ->
            %% From directory to file? This shouldn't happen
            {error, lists:flatten(
                      io_lib:format("Cannot copy dir (~p) to file (~p)\n",
                                    [SourceDir, DestDir]))};
        false ->
            %% Specifying a target directory that doesn't currently exist.
            %% So let's attempt to create this directory
            case filelib:ensure_dir(filename:join(DestDir, "dummy")) of
                ok ->
                    ok = xcopy_win32(SourceDir, DestDir);
                {error, Reason} ->
                    {error, lists:flatten(
                              io_lib:format("Unable to create dir ~p: ~p\n",
                                            [DestDir, Reason]))}
            end
    end;
cp_r_win32(Source,Dest) ->
    Dst = {filelib:is_dir(Dest), Dest},
    lists:foreach(fun(Src) ->
                          ok = cp_r_win32({filelib:is_dir(Src), Src}, Dst)
                  end, filelib:wildcard(Source)),
    ok.

escape_path(Str) ->
    re:replace(Str, "([ ()?])", "\\\\&", [global, {return, list}]).
%%/rebar_file_utils

setup_env() ->
    %% We don't need or want relx providers loaded yet
    application:load(rebar),
    {ok, Providers} = application:get_env(rebar, providers),
    Providers1 = Providers -- [rebar_prv_release,
                               rebar_prv_relup,
                               rebar_prv_tar],
    application:set_env(rebar, providers, Providers1).

reset_env() ->
    %% Reset the env so we get all providers
    application:unset_env(rebar, providers),
    application:unload(rebar),
    application:load(rebar).

write_windows_scripts() ->
    CmdScript=
        "@echo off\r\n"
        "setlocal\r\n"
        "set rebarscript=%~f0\r\n"
        "escript.exe \"%rebarscript:.cmd=%\" %*\r\n",
    ok = file:write_file("rebar3.cmd", CmdScript).

get_deps() ->
    case file:consult("rebar.lock") of
        {ok, [Deps]} ->
            [{binary_to_atom(Name, utf8), "", Source} || {Name, Source, _Level} <- Deps];
        _ ->
            {ok, Config} = file:consult("rebar.config"),
            proplists:get_value(deps, Config)
    end.

format_errors(Source, Errors) ->
    format_errors(Source, "", Errors).

format_warnings(Source, Warnings) ->
    format_warnings(Source, Warnings, []).

format_warnings(Source, Warnings, Opts) ->
    Prefix = case lists:member(warnings_as_errors, Opts) of
                 true -> "";
                 false -> "Warning: "
             end,
    format_errors(Source, Prefix, Warnings).

format_errors(_MainSource, Extra, Errors) ->
    [begin
         [format_error(Source, Extra, Desc) || Desc <- Descs]
     end
     || {Source, Descs} <- Errors].

format_error(AbsSource, Extra, {{Line, Column}, Mod, Desc}) ->
    ErrorDesc = Mod:format_error(Desc),
    io_lib:format("~s:~w:~w: ~s~s~n", [AbsSource, Line, Column, Extra, ErrorDesc]);
format_error(AbsSource, Extra, {Line, Mod, Desc}) ->
    ErrorDesc = Mod:format_error(Desc),
    io_lib:format("~s:~w: ~s~s~n", [AbsSource, Line, Extra, ErrorDesc]);
format_error(AbsSource, Extra, {Mod, Desc}) ->
    ErrorDesc = Mod:format_error(Desc),
    io_lib:format("~s: ~s~s~n", [AbsSource, Extra, ErrorDesc]).

additional_defines() ->
    [{d, D} || {Re, D} <- [{"^[0-9]+", namespaced_types}, {"^R1[4|5]", deprecated_crypto}], is_otp_release(Re)].

is_otp_release(ArchRegex) ->
    case re:run(otp_release(), ArchRegex, [{capture, none}]) of
        match ->
            true;
        nomatch ->
            false
    end.

otp_release() ->
    otp_release1(erlang:system_info(otp_release)).

%% If OTP <= R16, otp_release is already what we want.
otp_release1([$R,N|_]=Rel) when is_integer(N) ->
    Rel;
%% If OTP >= 17.x, erlang:system_info(otp_release) returns just the
%% major version number, we have to read the full version from
%% a file. See http://www.erlang.org/doc/system_principles/versions.html
%% Read vsn string from the 'OTP_VERSION' file and return as list without
%% the "\n".
otp_release1(Rel) ->
    File = filename:join([code:root_dir(), "releases", Rel, "OTP_VERSION"]),
    case file:read_file(File) of
        {error, _} ->
            Rel;
        {ok, Vsn} ->
            %% It's fine to rely on the binary module here because we can
            %% be sure that it's available when the otp_release string does
            %% not begin with $R.
            Size = byte_size(Vsn),
            %% The shortest vsn string consists of at least two digits
            %% followed by "\n". Therefore, it's safe to assume Size >= 3.
            case binary:part(Vsn, {Size, -3}) of
                <<"**\n">> ->
                    %% The OTP documentation mentions that a system patched
                    %% using the otp_patch_apply tool available to licensed
                    %% customers will leave a '**' suffix in the version as a
                    %% flag saying the system consists of application versions
                    %% from multiple OTP versions. We ignore this flag and
                    %% drop the suffix, given for all intents and purposes, we
                    %% cannot obtain relevant information from it as far as
                    %% tooling is concerned.
                    binary:bin_to_list(Vsn, {0, Size - 3});
                _ ->
                    binary:bin_to_list(Vsn, {0, Size - 1})
            end
    end.