1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(ts_install).
21
22-export([install/2, platform_id/1]).
23
24-include("ts.hrl").
25-include_lib("kernel/include/file.hrl").
26
27install(install_local, Options) ->
28    install(os:type(), Options);
29
30install(TargetSystem, Options) ->
31    case file:consult(?variables) of
32	{ok, Vars} ->
33	    case proplists:get_value(cross,Vars) of
34		"yes" when Options == []->
35		    target_install(Vars);
36		_ ->
37		    build_install(TargetSystem, Options)
38	    end;
39	_ ->
40	    build_install(TargetSystem, Options)
41    end.
42
43
44build_install(TargetSystem, Options) ->
45    XComp = parse_xcomp_file(proplists:get_value(xcomp,Options)),
46    case autoconf(TargetSystem, XComp++Options) of
47	{ok, Vars0} ->
48	    OsType = os_type(TargetSystem),
49	    Vars1 = ts_erl_config:variables(Vars0++XComp++Options,OsType),
50	    {Options1, Vars2} = add_vars(Vars1, Options),
51	    Vars3 = lists:flatten([Options1|Vars2]),
52	    write_terms(?variables, Vars3);
53	{error, Reason} ->
54	    {error, Reason}
55    end.
56
57os_type({unix,_}=OsType) -> OsType;
58os_type({win32,_}=OsType) -> OsType.
59
60target_install(CrossVars) ->
61    io:format("Cross installation detected, skipping configure and data_dir make~n"),
62    case file:rename(?variables,?cross_variables) of
63	ok ->
64	    ok;
65	_ ->
66	    io:format("Could not find variables file from cross make~n"),
67	    throw(cross_installation_failed)
68    end,
69    CPU = proplists:get_value('CPU',CrossVars),
70    OS = proplists:get_value(os,CrossVars),
71    {Options,Vars} = add_vars([{cross,"yes"},{'CPU',CPU},{os,OS}],[]),
72    Variables = lists:flatten([Options|Vars]),
73    write_terms(?variables, Variables).
74
75%% Autoconf for various platforms.
76%% unix uses the configure script
77%% win32 uses ts_autoconf_win32
78
79autoconf(TargetSystem, XComp) ->
80    case autoconf1(TargetSystem, XComp) of
81	ok ->
82	    autoconf2(file:read_file("conf_vars"));
83	Error ->
84	    Error
85    end.
86
87autoconf1({win32, _},[{cross,"no"}]) ->
88    ts_autoconf_win32:configure();
89autoconf1({unix, _},XCompFile) ->
90    unix_autoconf(XCompFile);
91autoconf1(_,_) ->
92    io:format("cross compilation not supported for that this platform~n"),
93    throw(cross_installation_failed).
94
95autoconf2({ok, Bin}) ->
96    get_vars(ts_lib:b2s(Bin), name, [], []);
97autoconf2(Error) ->
98    Error.
99
100get_vars([$:|Rest], name, Current, Result) ->
101    Name = list_to_atom(lists:reverse(Current)),
102    get_vars(Rest, value, [], [Name|Result]);
103get_vars([$\r|Rest], value, Current, Result) ->
104    get_vars(Rest, value, Current, Result);
105get_vars([$\n|Rest], value, Current, [Name|Result]) ->
106    Value = lists:reverse(Current),
107    get_vars(Rest, name, [], [{Name, Value}|Result]);
108get_vars([C|Rest], State, Current, Result) ->
109    get_vars(Rest, State, [C|Current], Result);
110get_vars([], name, [], Result) ->
111    {ok, Result};
112get_vars(_, _, _, _) ->
113    {error, fatal_bad_conf_vars}.
114
115unix_autoconf(XConf) ->
116    Configure = filename:absname("configure"),
117    Flags = proplists:get_value(crossflags,XConf,[]),
118    Env = proplists:get_value(crossenv,XConf,[]),
119    Host = get_xcomp_flag("host", Flags),
120    Build = get_xcomp_flag("build", Flags),
121    Threads = [" --enable-shlib-thread-safety" ||
122		  erlang:system_info(threads) /= false],
123    Debug = [" --enable-debug-mode" ||
124		string:find(erlang:system_info(system_version),"debug") =/= nomatch],
125    MXX_Build = [Y || Y <- string:lexemes(os:getenv("CONFIG_FLAGS", ""), " \t\n"),
126		      Y == "--enable-m64-build"
127			  orelse Y == "--enable-m32-build"],
128    Args = Host ++ Build ++ Threads ++ Debug ++ " " ++ MXX_Build,
129    case filelib:is_file(Configure) of
130	true ->
131	    OSXEnv = macosx_cflags(),
132	    UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)),
133	    io:format("Running ~ts~nEnv: ~p~n",
134		      [lists:flatten(Configure ++ Args),UnQuotedEnv]),
135	    Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])},
136			     [stream, eof, {env,UnQuotedEnv}]),
137	    ts_lib:print_data(Port);
138	false ->
139	    {error, no_configure_script}
140    end.
141
142unquote([{Var,Val}|T]) ->
143    [{Var,unquote(Val)}|unquote(T)];
144unquote([]) ->
145    [];
146unquote("\""++Rest) ->
147    lists:reverse(tl(lists:reverse(Rest)));
148unquote(String) ->
149    String.
150
151assign_vars([]) ->
152    [];
153assign_vars([{VAR,FlagsStr} | VARs]) ->
154    [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)];
155assign_vars(FlagsStr) ->
156    Flags = [assign_all_vars(Str,[]) || Str <- string:lexemes(FlagsStr, [$\s])],
157    lists:flatten(lists:join(" ", Flags)).
158
159assign_all_vars([$$ | Rest], FlagSoFar) ->
160    {VarName,Rest1} = get_var_name(Rest, []),
161    assign_all_vars(Rest1, FlagSoFar ++ os:getenv(VarName, ""));
162assign_all_vars([Char | Rest], FlagSoFar) ->
163    assign_all_vars(Rest, FlagSoFar ++ [Char]);
164assign_all_vars([], Flag) ->
165    Flag.
166
167get_var_name([Ch | Rest] = Str, VarR) ->
168    case valid_char(Ch) of
169	true  -> get_var_name(Rest, [Ch | VarR]);
170	false -> {lists:reverse(VarR),Str}
171    end;
172get_var_name([], VarR) ->
173    {lists:reverse(VarR),[]}.
174
175valid_char(Ch) when Ch >= $a, Ch =< $z -> true;
176valid_char(Ch) when Ch >= $A, Ch =< $Z -> true;
177valid_char(Ch) when Ch >= $0, Ch =< $9 -> true;
178valid_char($_)                         -> true;
179valid_char(_)                          -> false.
180
181get_xcomp_flag(Flag, Flags) ->
182    get_xcomp_flag(Flag, Flag, Flags).
183get_xcomp_flag(Flag, Tag, Flags) ->
184    case proplists:get_value(Flag,Flags) of
185	undefined -> "";
186	"guess" -> [" --",Tag,"=",os:cmd("$ERL_TOP/erts/autoconf/config.guess")];
187	HostVal -> [" --",Tag,"=",HostVal]
188    end.
189
190
191macosx_cflags() ->
192    case os:type() of
193	{unix, darwin} ->
194	    %% To ensure that the drivers we build can be loaded
195	    %% by the emulator, add either -m32 or -m64 to CFLAGS.
196	    WordSize = erlang:system_info(wordsize),
197	    Mflag = "-m" ++ integer_to_list(8*WordSize),
198	    [{"CFLAGS", Mflag},{"LDFLAGS", Mflag}];
199	_ ->
200	    []
201    end.
202
203parse_xcomp_file(undefined) ->
204    [{cross,"no"}];
205parse_xcomp_file(Filepath) ->
206    {ok,Bin} = file:read_file(Filepath),
207    Lines = binary:split(Bin,<<"\n">>,[global,trim]),
208    {Envs,Flags} = parse_xcomp_file(Lines,[],[]),
209    [{cross,"yes"},{crossroot,os:getenv("ERL_TOP")},
210     {crossenv,Envs},{crossflags,Flags}].
211
212parse_xcomp_file([<<A:8,_/binary>> = Line|R],Envs,Flags)
213  when $A =< A, A =< $Z ->
214    [Var,Value] = binary:split(Line,<<"=">>),
215    parse_xcomp_file(R,[{ts_lib:b2s(Var),
216			 ts_lib:b2s(Value)}|Envs],Flags);
217parse_xcomp_file([<<"erl_xcomp_",Line/binary>>|R],Envs,Flags) ->
218    [Var,Value] = binary:split(Line,<<"=">>),
219    parse_xcomp_file(R,Envs,[{ts_lib:b2s(Var),
220			      ts_lib:b2s(Value)}|Flags]);
221parse_xcomp_file([_|R],Envs,Flags) ->
222    parse_xcomp_file(R,Envs,Flags);
223parse_xcomp_file([],Envs,Flags) ->
224    {lists:reverse(Envs),lists:reverse(Flags)}.
225
226write_terms(Name, Terms) ->
227    case file:open(Name, [write]) of
228	{ok, Fd} ->
229	    Result = write_terms1(Fd, remove_duplicates(Terms)),
230	    file:close(Fd),
231	    Result;
232	{error, Reason} ->
233	    {error, Reason}
234    end.
235
236write_terms1(Fd, [Term|Rest]) ->
237    ok = io:format(Fd, "~p.\n", [Term]),
238    write_terms1(Fd, Rest);
239write_terms1(_, []) ->
240    ok.
241
242remove_duplicates(List) ->
243    lists:reverse(
244      lists:foldl(fun({Key,Val},Acc) ->
245			  R = make_ref(),
246			  case proplists:get_value(Key,Acc,R) of
247			      R -> [{Key,Val}|Acc];
248			      _Else ->
249				  Acc
250			  end
251		  end,[],List)).
252
253add_vars(Vars0, Opts0) ->
254    {Opts,LongNames} =
255	case lists:keymember(longnames, 1, Opts0) of
256	    true ->
257		{lists:keydelete(longnames, 1, Opts0),true};
258	    false ->
259		{Opts0,false}
260	end,
261    {PlatformId, PlatformLabel, PlatformFilename, Version} =
262	platform([{longnames, LongNames}|Vars0]),
263    NetDir = lists:concat(["/net", hostname()]),
264    Mounted = case file:read_file_info(NetDir) of
265		  {ok, #file_info{type = directory}} -> NetDir;
266		  _ -> ""
267	      end,
268    {Opts, [{longnames, LongNames},
269	    {platform_id, PlatformId},
270	    {platform_filename, PlatformFilename},
271	    {rsh_name, os:getenv("ERL_RSH", "ssh")},
272	    {platform_label, PlatformLabel},
273	    {ts_net_dir, Mounted},
274	    {erl_flags, []},
275	    {erl_release, Version},
276	    {ts_testcase_callback, get_testcase_callback()} | Vars0]}.
277
278get_testcase_callback() ->
279    case os:getenv("TS_TESTCASE_CALLBACK") of
280	ModFunc when is_list(ModFunc), ModFunc /= "" ->
281	    case string:lexemes(ModFunc, " ") of
282		[_Mod,_Func] -> ModFunc;
283		_ -> ""
284	    end;
285	_ ->
286	    case init:get_argument(ts_testcase_callback) of
287		{ok,[[Mod,Func]]} -> Mod ++ " " ++ Func;
288		_ -> ""
289	    end
290    end.
291
292platform_id(Vars) ->
293    {Id,_,_,_} = platform(Vars),
294    Id.
295
296platform(Vars) ->
297    Hostname = hostname(),
298
299    {Type,Version} = ts_lib:erlang_type(),
300    Cpu = ts_lib:var('CPU', Vars),
301    Os = ts_lib:var(os, Vars),
302
303    ErlType = to_upper(atom_to_list(Type)),
304    OsType = ts_lib:initial_capital(Os),
305    CpuType = ts_lib:initial_capital(Cpu),
306    LinuxDist = linux_dist(),
307    ExtraLabel = extra_platform_label(),
308    Schedulers = schedulers(),
309    BindType = bind_type(),
310    KP = kernel_poll(),
311    IOTHR = io_thread(),
312    LC = lock_checking(),
313    MT = modified_timing(),
314    AsyncThreads = async_threads(),
315    OffHeapMsgQ = off_heap_msgq(),
316    Debug = debug(),
317    CpuBits = word_size(),
318    Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist,
319			   Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads,
320			   OffHeapMsgQ,Debug,ExtraLabel]),
321    PlatformId = lists:concat([ErlType, " ", Version, Common]),
322    PlatformLabel = ErlType ++ Common,
323    PlatformFilename = platform_as_filename(PlatformId),
324    {PlatformId, PlatformLabel, PlatformFilename, Version}.
325
326platform_as_filename(Label) ->
327    lists:map(fun($ ) -> $_;
328		 ($/) -> $_;
329		 (C) when $A =< C, C =< $Z -> C - $A + $a;
330		 (C) -> C end,
331	      Label).
332
333to_upper(String) ->
334    lists:map(fun(C) when $a =< C, C =< $z -> C - $a + $A;
335		 (C) -> C end,
336	      String).
337
338word_size() ->
339    case {erlang:system_info({wordsize,external}),
340	  erlang:system_info({wordsize,internal})} of
341	{4,4} -> "";
342	{8,8} -> "/64";
343	{8,4} -> "/Halfword"
344    end.
345
346linux_dist() ->
347    case os:type() of
348	{unix,linux} ->
349	    linux_dist_1([fun linux_dist_suse/0]);
350	_ -> ""
351    end.
352
353linux_dist_1([F|T]) ->
354    case F() of
355	"" -> linux_dist_1(T);
356	Str -> Str
357    end;
358linux_dist_1([]) -> "".
359
360linux_dist_suse() ->
361    case filelib:is_file("/etc/SuSE-release") of
362	false -> "";
363	true ->
364	    Ver0 = os:cmd("awk '/^VERSION/ {print $3}' /etc/SuSE-release"),
365	    [_|Ver1] = lists:reverse(Ver0),
366	    Ver = lists:reverse(Ver1),
367	    "/Suse" ++ Ver
368    end.
369
370hostname() ->
371    case catch inet:gethostname() of
372	{ok, Hostname} when is_list(Hostname) ->
373	    "/" ++ lists:takewhile(fun (C) -> C /= $. end, Hostname);
374	_ ->
375	    "/localhost"
376    end.
377
378async_threads() ->
379    case catch erlang:system_info(threads) of
380	true -> "/A"++integer_to_list(erlang:system_info(thread_pool_size));
381	_ -> ""
382    end.
383
384off_heap_msgq() ->
385    case catch erlang:system_info(message_queue_data) of
386	off_heap -> "/OffHeapMsgQ";
387	_ -> ""
388    end.
389
390schedulers() ->
391    case {erlang:system_info(schedulers),
392          erlang:system_info(schedulers_online)} of
393        {S,S} ->
394            "/S"++integer_to_list(S);
395        {S,O} ->
396            "/S"++integer_to_list(S) ++ ":" ++
397                integer_to_list(O)
398    end.
399
400bind_type() ->
401    case catch erlang:system_info(scheduler_bind_type) of
402	thread_no_node_processor_spread -> "/sbttnnps";
403	no_node_processor_spread -> "/sbtnnps";
404	no_node_thread_spread -> "/sbtnnts";
405	processor_spread -> "/sbtps";
406	thread_spread -> "/sbtts";
407	no_spread -> "/sbtns";
408	_ -> ""
409    end.
410
411
412debug() ->
413    case string:find(erlang:system_info(system_version), "debug") of
414	nomatch -> "";
415	_ -> "/Debug"
416    end.
417
418lock_checking() ->
419    case catch erlang:system_info(lock_checking) of
420	true -> "/LC";
421	_ -> ""
422    end.
423
424modified_timing() ->
425    case catch erlang:system_info(modified_timing_level) of
426	N when is_integer(N) ->
427	    "/T" ++ integer_to_list(N);
428	_ -> ""
429    end.
430
431kernel_poll() ->
432    case catch erlang:system_info(kernel_poll) of
433	true -> "/KP";
434	_ -> ""
435    end.
436
437io_thread() ->
438    case catch erlang:system_info(io_thread) of
439	true -> "/IOTHR";
440	_ -> ""
441    end.
442
443extra_platform_label() ->
444    case os:getenv("TS_EXTRA_PLATFORM_LABEL") of
445	[] -> "";
446	[_|_]=Label -> "/" ++ Label;
447	false -> ""
448    end.
449