exorel

#!/usr/bin/env escript
%% -*- erlang -*-

-mode(compile).
-compile({no_auto_import,[nodes/1]}).

-define(TARGET, "exodm").

main([]) -> help();
main(["help"]) -> help();
main([F|Args0] = _A) ->
    %% this insanity with 're' is because my terminal sometimes passes
    %% a non-space space character appended to the command.
    {Env, Args} = parse_opts(Args0),
    try list_to_existing_atom(
	   re:replace(F, "[^a-z_]", "", [global,{return,list}])) of
	tar      -> tar(Args, Env);
	git_vsn  -> git_vsn(Args, Env);
	nodes    -> nodes(Args, Env);
	versions -> versions(Args, Env);
	current  -> current(Args, Env);
	last_build -> last_build(Args, Env);
	root -> io:fwrite("root: ~p~n", [root_dir(Env)]); % for debugging
	_ -> help()
    catch
	_:_ ->
	    help()
    end.

parse_opts(Args) ->
    parse_opts(Args, [], []).

parse_opts(["-root", D|Args], Env, Opts) ->
    parse_opts(Args, [{root, D}|Env], Opts);
parse_opts([X|Args], Env, Opts) ->
    parse_opts(Args, Env, [X|Opts]);
parse_opts([], Env, Opts) ->
    {lists:reverse(Env), lists:reverse(Opts)}.


help() ->
    io:fwrite(
"Usage: ~s Cmd [Opts] [Arg]~n"
"General options:~n"
"  -root D    : Root directory of the exodm installation.~n"
"Valid commands and options:~n"
"  git_vsn    : prints the git version of the repos top directory.~n"
"  nodes      : prints the names of the currently defined nodes.~n"
"  versions   : prints all currently installed versions.~n"
"  current    : prints the version set as 'current', if there is one;~n"
"               otherwise, marks the latest installed version as current.~n"
"  current V  : marks the installed version (matching) V as current.~n"
"  last_build : prints the version of the system most recently generated.~n",
      [filename:basename(escript:script_name())]),
    halt(1).

tar([V], Env) ->
    Base = "exodm_" ++ V,
    Top = filename:join(Dir = rel_lib_dir(Env), Base),
    Target0 = filename:join(Dir, Base ++ ".tgz"),
    Target = filename:absname(Target0),
    case filelib:is_regular(Target0) of
	false ->
	    TmpDir = make_temp_dir(),
	    io:fwrite("TmpDir: ~s~n", [os:cmd("ls -R " ++ TmpDir)]),
	    Res = os:cmd(Cmd = "cp -r " ++ Top ++ " " ++
			     TmpDir ++ "/" ++ rel_path()),
	    io:fwrite("~s ->~n  ~s~n", [Cmd, Res]),
	    NewDir = filename:join([TmpDir, rel_path(), Base]),
	    io:fwrite("NewDir = ~s~n", [NewDir]),
	    Res1 = os:cmd(Cmd1 = "(cd " ++ root_dir(Env) ++ "; "
			  "cp exorel make_node " ++ NewDir ++ "/)"),
	    io:fwrite("~s ->~n  ~s~n", [Cmd1, Res1]),
	    {ok,_} = beam_lib:strip_release(NewDir),
	    make_tar(TmpDir, "*", Target),
	    os:cmd("rm -rf " ++ TmpDir),
	    io:fwrite("Stripped archive in ~s~n", [Target0]);
	true ->
	    abort("Archive exists [~s]~n", [Target0])
    end.

rel_path() ->
    "rel/lib".

make_tar(Dir, SubDir, Target) ->
    Cwd = cwd(),
    ok = file:set_cwd(Dir),
    TarRes = os:cmd(TarCmd = "tar czf " ++ Target ++ " " ++ SubDir),
    io:fwrite("~s ->~n~s~n", [TarCmd, TarRes]),
    file:set_cwd(Cwd).


make_temp_dir() ->
    {M,S,U} = os:timestamp(),
    D = filename:join("/tmp", lists:concat([escript:script_name(),"-",
					    integer_to_list(M),".",
					    integer_to_list(S),".",
					    integer_to_list(U)])),
    ok = file:make_dir(D),
    ok = filelib:ensure_dir(filename:join([D, rel_path(), "foo"])),
    D.

git_vsn([V], _Env) -> io:fwrite("~s~n", [V]);
git_vsn(Opts, Env) ->
    case os:getenv("EXO_VSN") of
	[_|_] = Vsn ->
	    io:fwrite("~s~n", [Vsn]);
	_ ->
	    Cwd = cwd(),
	    Dir = case Opts of
		      [] -> root_dir(Env);
		      ["-d",D|_] -> D
		  end,
	    ok = file:set_cwd(Dir),
	    Res = os:cmd("git describe --always --tags "
			 "`git log -n 1 --pretty=format:%h .`"),
	    file:set_cwd(Cwd),
	    io:fwrite("~s~n", [re:replace(Res,"\\n","",[{return,list}])])
    end.

nodes([], Env) ->
    case file:list_dir(Dir = filename:join(root_dir(Env), "nodes")) of
	{ok, Fs} ->
	    list_files(Fs, Dir, []);
	_ ->
	    nothing
    end.

versions([], Env) ->
    case file:list_dir(Dir = rel_lib_dir(Env)) of
	{ok, Fs} ->
	    list_files(Fs, Dir, ["exodm"]);
	_ ->
	    nothing
    end.

list_files(Fs0, Dir, Exclude) ->
    case [vsn_part(F1) || F1 <- sort_vsns(Fs0),
			  filelib:is_dir(filename:join(Dir, F1)),
			  not lists:member(F1, Exclude)] of
	[F|Fs] ->
	    io:fwrite("~s~n", [F ++ lists:concat(["," ++ F1 || F1 <- Fs])]);
	[] ->
	    nothing
    end.


current([], Env) ->
    case file:read_link(filename:join(rel_dir(Env), ?TARGET)) of
	{ok, Vsn} ->
	    io:fwrite("~s~n", [vsn_part(Vsn)]);
	{error, enoent} ->
	    case file:list_dir(rel_lib_dir(Env)) of
		{ok, []} -> nothing;
		{ok, Fs} ->
		    [Latest|_] = sort_vsns(Fs),
		    make_current(Latest, Env),
		    io:fwrite("~s~n", [vsn_part(Latest)]);
		_ ->
		    nothing
	    end
    end;
current([Vsn], Env) ->
    case file:list_dir(rel_lib_dir(Env)) of
	{ok, Fs} ->
	    case [F || F <- Fs -- "exodm", vsn_matches(Vsn, F)] of
		[ActualVsn] ->
		    current_(ActualVsn, Env);
		[] ->
		    io:fwrite("error: no such version~n", []),
		    halt(1);
		[_|_] = Multiple ->
		    case lists:member(Actual = "exodm_" ++ Vsn, Multiple) of
			true ->
			    current_(Actual, Env);
			false ->
			    io:fwrite("error: ambiguous~n", []),
			    halt(1)
		    end
	    end;
	_ ->
	    io:fwrite("error: no such version~n", []),
	    halt(1)
    end.

current_(ActualVsn, Env) ->
    file:delete(filename:join(rel_dir(Env), ?TARGET)),
    make_current(filename:join(rel_lib_dir(Env), ActualVsn), Env),
    io:fwrite("~s~n", [vsn_part(ActualVsn)]).


vsn_part(F) ->
    case re:split(Base = filename:basename(F), "_", [{return,list}]) of
	[_, V] -> V;
	_ -> Base
    end.

last_build([], Env) ->
    case file:consult(filename:join(rel_dir(Env), "reltool.config")) of
	{ok, Terms} ->
	    case [Sys || {sys, Sys} <- Terms] of
		[Items|_] ->
		    [Version] = [V || {rel,T,V,_} <- Items, T == ?TARGET],
		    io:fwrite("~s~n", [Version]);
		_ ->
		    nothing
	    end;
	_ ->
	    nothing
    end.

vsn_matches(V, FullV) ->
    case re:run(FullV, V) of
	{match,_} -> true;
	nomatch   -> false
    end.

make_current(F, Env) ->
    Cwd = cwd(),
    RelD = rel_dir(Env),
    LibD = rel_lib_dir(Env),
    Base = filename:basename(F),
    _CwdRes1 = file:set_cwd(RelD),
    Res = file:make_symlink(Source1 = filename:join("lib", Base), ?TARGET),
    io:fwrite("make_symlink(Dir = ~p, ~p, ~p) -> ~p~n",
	      [RelD, Source1, ?TARGET, Res]),
    CopyRes = file:copy(
		RT = filename:join(Source1, "reltool.config"), "reltool.config"),
    io:fwrite("Copy ~s to reltool.config -> ~p~n", [RT, CopyRes]),
    file:set_cwd(Cwd),
    _CwdRes2 = file:set_cwd(LibD),
    DelRes = file:delete(?TARGET),
    io:fwrite("deleting file ~p -> ~p~n", [?TARGET, DelRes]),
    Res2 = file:make_symlink(Base, ?TARGET),
    io:fwrite("make_symlink(Dir = ~p, ~p, ~p) -> ~p~n",
	      [LibD, Base, ?TARGET, Res2]),
    file:set_cwd(Cwd),
    maybe_copy_vm_args(Cwd, Base, filename:join("rel", Source1)).

maybe_copy_vm_args(Cwd, Base, Source) ->
    [_, Vsn] = re:split(Base, <<"_">>, [{return, list}]),
    case filelib:is_regular(F = filename:join(
				  [Source, "releases", Vsn, "vm.args"])) of
	true ->
	    case filelib:is_regular(
		   LocalVmArgs = filename:join(Cwd, "vm.args")) of
		true ->
		    io:fwrite("vm.args already copied to CWD~n", []),
		    ok;
		false ->
		    io:fwrite("copying vm.args to CWD...~n", []),
		    file:copy(F, LocalVmArgs)
	    end,
	    SysConfig = filename:join(filename:dirname(F), "sys.config"),
	    case filelib:is_regular(
		   LocalSysConfig = filename:join(Cwd, "sys.config")) of
		true ->
		    ok;
		false ->
		    io:fwrite("copying sys.config to CWD...~n", []),
		    file:copy(SysConfig, LocalSysConfig)
	    end,
	    ok;
	false ->
	    io:fwrite("WARNING: cannot find ~s~n", [F])
    end.

root_dir(Env) ->
    case lists:keyfind(root, 1, Env) of
	false ->
	    root_dir_(filename:dirname(escript:script_name()));
	{_, Root} ->
	    Root
    end.

root_dir_(".") ->
    root_dir_(cwd());
root_dir_(D) ->
    case get_root_from_exodm_env() of
	{ok, R} -> R;
	error   -> derive_root_dir(D)
    end.

get_root_from_exodm_env() ->
    case file:read_file(".exodm_env") of
	{ok, Bin} ->
	    case re:run(Bin, <<"EXODM_DIR=(.+)">>,
			[{capture,all_but_first,list}]) of
		{match, [Root]} ->
		    {ok, Root};
		_Other ->
		    io:fwrite(
		      "*error* cannot read EXODM_DIR in .exodm_env~n", []),
		    error
	    end;
	_ ->
	    error
    end.

derive_root_dir(D) ->
    case filelib:is_dir(_X = filename:join([D, "rel", "lib"])) of
	true ->
	    fulldir(D);
	false ->
	    case find_exodm_dev_repos(fulldir(D)) of
		{true, D1} ->
		    D1;
		false ->
		    {ok, Fs} = file:list_dir(D),
		    case ["releases", "bin", "erts", "ctl", "exorel"] -- Fs of
			[] ->
			    %% io:fwrite("found \"releases\", etc.~n", []),
			    filename:dirname(
			      filename:dirname(
				filename:dirname(D)));
			_ ->
			    abort("Cannot recognize directory~n", [])
		    end;
		Other ->
		    abort("is_dir(~p) -> ~p~n", [_X, Other])
	    end
    end.

find_exodm_dev_repos([]) -> false;
find_exodm_dev_repos(D) ->
    case is_exodm_dev_repos(D) of
	true ->
	    {true, fulldir(D)};
	false ->
	    find_exodm_dev_repos(filename:dirname(D))
    end.
    
is_exodm_dev_repos(D) ->
    case filename:basename(D) of
	"exodm" ->
	    case file:list_dir(D) of
		{ok, Fs} ->
		    [] == [".git", "make_node", "exorel", "rebar.config"] -- Fs;
		{error, _} ->
		    abort("Cannot read CWD~n", [])
	    end;
	_ ->
	    false
    end.

rel_dir(Env)  -> filename:join(root_dir(Env), "rel").

rel_lib_dir(Env)  -> filename:join(rel_dir(Env), "lib").


%% modified version of setup:sort_vsns/2
sort_vsns(Rels) ->
    lists:sort(fun(Ra, Rb) ->
                       compare_vsns(take_vsn(Ra), take_vsn(Rb))
               end,
               Rels).

take_vsn(R) ->
    case re:split(R, "_", [{return,list}]) of
	[_, V] ->
	    V;
	_ ->
	    R
    end.

compare_vsns(V1, V2) ->
    ToS = fun(V) ->
                  _S = [pad_x(X) || X <- string:tokens(V, ".-")]
          end,
    ToS(V1) < ToS(V2).

pad_x(X) ->
    try _ = list_to_integer(X),
	  lists:duplicate(30 - length(X), $0) ++ X
    catch
	error:_ ->
	    [flip(C) || C <- X]
    end.
    %% lists:duplicate(30 - length(S), $0) ++ [flip(C) || C <- S].

flip(C) when $a =< C, C =< $z -> $A + (C - $a);
flip(C) when $A =< C, C =< $Z -> $a + (C - $A);
flip(C) -> C.


abort(Fmt, Args) ->
    io:fwrite(Fmt, Args),
    halt(1).


%% find_root() ->
%%     {ok,CWD} = file:get_cwd(),
%%     find_root(CWD).

cwd() ->
    filename:dirname(filename:absname(".")).

fulldir(D) ->
    case filename:pathtype(D) of
	relative ->
	    {ok,CWD} = file:get_cwd(),
	    try
		ok = file:set_cwd(D),
		cwd()
	    after
		file:set_cwd(CWD)
	    end;
	_ ->
	    filename:absname(D)
    end.