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(beam_lib_SUITE).
21
22%%-define(debug, true).
23
24-ifdef(debug).
25-define(format(S, A), io:format(S, A)).
26-define(line, put(line, ?LINE), ).
27-define(config(X,Y), "./log_dir/").
28-define(privdir, "beam_lib_SUITE_priv").
29-else.
30-include_lib("common_test/include/ct.hrl").
31-define(format(S, A), ok).
32-define(privdir, proplists:get_value(priv_dir, Conf)).
33-endif.
34
35-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
36	 init_per_group/2,end_per_group/2,
37	 normal/1, error/1, cmp/1, cmp_literals/1, strip/1, strip_add_chunks/1, otp_6711/1,
38         building/1, md5/1, encrypted_abstr/1, encrypted_abstr_file/1,
39         missing_debug_info_backend/1]).
40-export([test_makedep_abstract_code/1]).
41
42-export([init_per_testcase/2, end_per_testcase/2]).
43
44suite() ->
45    [{ct_hooks,[ts_install_cth]},
46     {timetrap,{minutes,2}}].
47
48all() ->
49    [error, normal, cmp, cmp_literals, strip, strip_add_chunks, otp_6711,
50     building, md5, encrypted_abstr, encrypted_abstr_file,
51     missing_debug_info_backend, test_makedep_abstract_code
52    ].
53
54groups() ->
55    [].
56
57init_per_suite(Config) ->
58    Config.
59
60end_per_suite(_Config) ->
61    ok.
62
63init_per_group(_GroupName, Config) ->
64    Config.
65
66end_per_group(_GroupName, Config) ->
67    Config.
68
69
70init_per_testcase(_Case, Config) ->
71    Config.
72
73end_per_testcase(_Case, _Config) ->
74    ok.
75
76%% Read correct beam file.
77normal(Conf) when is_list(Conf) ->
78    PrivDir = ?privdir,
79    Simple = filename:join(PrivDir, "simple"),
80    Source = Simple ++ ".erl",
81    BeamFile = Simple ++ ".beam",
82    simple_file(Source),
83
84    NoOfTables = erlang:system_info(ets_count),
85    P0 = pps(),
86
87    do_normal(Source, PrivDir, BeamFile, []),
88    do_normal(Source, PrivDir, BeamFile, [no_utf8_atoms]),
89
90    {ok,_} = compile:file(Source, [{outdir,PrivDir}, no_debug_info]),
91    {ok, {simple, [{debug_info, {debug_info_v1, erl_abstract_code, {none, _}}}]}} =
92	beam_lib:chunks(BeamFile, [debug_info]),
93    {ok, {simple, [{abstract_code, no_abstract_code}]}} =
94	beam_lib:chunks(BeamFile, [abstract_code]),
95
96    %% {ok,_} = compile:file(Source, [compressed | CompileFlags]),
97    %% do_normal(BeamFile),
98
99    file:delete(BeamFile),
100    file:delete(Source),
101    NoOfTables = erlang:system_info(ets_count),
102    true = (P0 == pps()),
103    ok.
104
105do_normal(Source, PrivDir, BeamFile, Opts) ->
106    CompileFlags = [{outdir,PrivDir}, debug_info | Opts],
107    {ok,_} = compile:file(Source, CompileFlags),
108    {ok, Binary} = file:read_file(BeamFile),
109
110    do_normal(BeamFile, Opts),
111    do_normal(Binary, Opts).
112
113do_normal(BeamFile, Opts) ->
114    Imports = {imports, [{erlang, get_module_info, 1},
115			 {erlang, get_module_info, 2},
116			 {lists, member, 2}]},
117    Exports = {exports, [{module_info, 0}, {module_info, 1}, {t, 0}]},
118    Local = {locals, [{t, 1}]},
119    {ok, {simple, [Imports]}} = beam_lib:chunks(BeamFile, [imports]),
120    {ok, {simple, [{"ImpT",_Bin}]}} =
121	beam_lib:chunks(BeamFile, ["ImpT"]),
122    {ok, {simple, [Exports]}} = beam_lib:chunks(BeamFile, [exports]),
123    {ok, {simple, [{attributes, [{vsn, [_]}]}]}} =
124	beam_lib:chunks(BeamFile, [attributes]),
125    {ok, {simple, [{compile_info, _}=CompileInfo]}} =
126	beam_lib:chunks(BeamFile, [compile_info]),
127    {ok, {simple, [Local]}} = beam_lib:chunks(BeamFile, [locals]),
128    {ok, {simple, [{attributes, [{vsn, [_]}]}, CompileInfo,
129		   Exports, Imports, Local]}} =
130	beam_lib:chunks(BeamFile, [attributes, compile_info, exports, imports, locals]),
131    {ok, {simple, [{atoms, _Atoms}]}} =
132	beam_lib:chunks(BeamFile, [atoms]),
133    {ok, {simple, [{labeled_exports, _LExports}]}} =
134	beam_lib:chunks(BeamFile, [labeled_exports]),
135    {ok, {simple, [{labeled_locals, _LLocals}]}} =
136	beam_lib:chunks(BeamFile, [labeled_locals]),
137    {ok, {simple, [_Vsn]}} = beam_lib:version(BeamFile),
138    {ok, {simple, [{abstract_code, {_, _}}]}} =
139	beam_lib:chunks(BeamFile, [abstract_code]),
140    {ok, {simple, [{debug_info, {debug_info_v1, erl_abstract_code, _}}]}} =
141	beam_lib:chunks(BeamFile, [debug_info]),
142
143    %% Test reading optional chunks.
144    All = ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT", "AtU8"],
145    {ok,{simple,Chunks}} = beam_lib:chunks(BeamFile, All, [allow_missing_chunks]),
146    case {verify_simple(Chunks),Opts} of
147	{{missing_chunk, AtomBin}, []} when is_binary(AtomBin) -> ok;
148	{{AtomBin, missing_chunk}, [no_utf8_atoms]} when is_binary(AtomBin) -> ok
149    end,
150
151    %% 'allow_missing_chunks' should work for named chunks too.
152    {ok, {simple, StrippedBeam}} = beam_lib:strip(BeamFile),
153    {ok, {simple, MChunks}} = beam_lib:chunks(StrippedBeam,
154                                              [attributes, locals],
155                                              [allow_missing_chunks]),
156    [{attributes, missing_chunk}, {locals, missing_chunk}] = MChunks,
157
158    %% Make sure that reading the atom chunk works when the 'allow_missing_chunks'
159    %% option is used.
160    Some = ["Code",atoms,"ExpT","LitT"],
161    {ok,{simple,SomeChunks}} = beam_lib:chunks(BeamFile, Some, [allow_missing_chunks]),
162    [{"Code",<<_/binary>>},{atoms,[_|_]},{"ExpT",<<_/binary>>},{"LitT",missing_chunk}] =
163	SomeChunks.
164
165verify_simple([{"Atom", PlainAtomChunk},
166	       {"Code", CodeBin},
167	       {"StrT", StrBin},
168	       {"ImpT", ImpBin},
169	       {"ExpT", ExpBin},
170	       {"FunT", missing_chunk},
171	       {"LitT", missing_chunk},
172	       {"AtU8", AtU8Chunk}])
173  when is_binary(CodeBin), is_binary(StrBin),
174       is_binary(ImpBin), is_binary(ExpBin) ->
175    {PlainAtomChunk, AtU8Chunk}.
176
177%% Read invalid beam files.
178error(Conf) when is_list(Conf) ->
179    PrivDir = ?privdir,
180    Simple = filename:join(PrivDir, "simple"),
181    Source = Simple ++ ".erl",
182    BeamFile = Simple ++ ".beam",
183    WrongFile = Simple ++ "foo.beam",
184    simple_file(Source),
185
186    NoOfTables = erlang:system_info(ets_count),
187    P0 = pps(),
188    {ok,_} = compile:file(Source, [{outdir,PrivDir},debug_info]),
189    ACopy = filename:join(PrivDir, "a_copy.beam"),
190    copy_file(BeamFile, ACopy),
191
192    {ok, Binary} = file:read_file(BeamFile),
193
194    copy_file(ACopy, WrongFile),
195    verify(file_error, beam_lib:info("./does_simply_not_exist")),
196
197    do_error(BeamFile, ACopy),
198    do_error(Binary, ACopy),
199
200    copy_file(ACopy, BeamFile),
201    verify(unknown_chunk, beam_lib:chunks(BeamFile, [not_a_chunk])),
202
203    ok = file:write_file(BeamFile, <<>>),
204    verify(not_a_beam_file, beam_lib:info(BeamFile)),
205    verify(not_a_beam_file, beam_lib:info(<<>>)),
206    ok = file:write_file(BeamFile, <<"short">>),
207    verify(not_a_beam_file, beam_lib:info(BeamFile)),
208    verify(not_a_beam_file, beam_lib:info(<<"short">>)),
209
210    {Binary1, _} = split_binary(Binary, byte_size(Binary)-10),
211    LastChunk = last_chunk(Binary),
212    verify(chunk_too_big, beam_lib:chunks(Binary1, [LastChunk])),
213    Chunks = chunk_info(Binary),
214    {value, {_, DebugInfoStart, _}} = lists:keysearch("Dbgi", 1, Chunks),
215    {Binary2, _} = split_binary(Binary, DebugInfoStart),
216    verify(chunk_too_big, beam_lib:chunks(Binary2, ["Dbgi"])),
217    {Binary3, _} = split_binary(Binary, DebugInfoStart-4),
218    verify(invalid_beam_file, beam_lib:chunks(Binary3, ["Dbgi"])),
219
220    %% Instead of the 5:32 field below, there used to be control characters
221    %% (including zero bytes) directly in the string. Because inferior programs
222    %% such as sed and clearcasediff don't like zero bytes in text files,
223    %% we have eliminated them.
224    ok = file:write_file(BeamFile, <<"FOR1",5:32,"BEAMfel">>),
225
226    NoOfTables = erlang:system_info(ets_count),
227    true = (P0 == pps()),
228    file:delete(Source),
229    file:delete(WrongFile),
230    file:delete(BeamFile),
231    file:delete(ACopy),
232    ok.
233
234last_chunk(Bin) ->
235    L = beam_lib:info(Bin),
236    {chunks,Chunks} = lists:keyfind(chunks, 1, L),
237    {Last,_,_} = lists:last(Chunks),
238    Last.
239
240do_error(BeamFile, ACopy) ->
241    %% evil tests
242    Chunks = chunk_info(BeamFile),
243    {value, {_, AtomStart, _}} = lists:keysearch("AtU8", 1, Chunks),
244    {value, {_, ImportStart, _}} = lists:keysearch("ImpT", 1, Chunks),
245    {value, {_, DebugInfoStart, _}} = lists:keysearch("Dbgi", 1, Chunks),
246    {value, {_, AttributesStart, _}} =
247	lists:keysearch("Attr", 1, Chunks),
248    {value, {_, CompileInfoStart, _}} =
249	lists:keysearch("CInf", 1, Chunks),
250    verify(missing_chunk, beam_lib:chunks(BeamFile, ["__"])),
251    BF2 = set_byte(ACopy, BeamFile, ImportStart+4, 17),
252    verify(invalid_chunk, beam_lib:chunks(BF2, [imports])),
253    BF3 = set_byte(ACopy, BeamFile, AtomStart-6, 17),
254    verify(missing_chunk, beam_lib:chunks(BF3, [imports])),
255    BF4 = set_byte(ACopy, BeamFile, DebugInfoStart+10, 17),
256    verify(invalid_chunk, beam_lib:chunks(BF4, [debug_info])),
257    BF5 = set_byte(ACopy, BeamFile, AttributesStart+8, 17),
258    verify(invalid_chunk, beam_lib:chunks(BF5, [attributes])),
259
260    BF6 = set_byte(ACopy, BeamFile, 1, 17),
261    verify(not_a_beam_file, beam_lib:info(BF6)),
262    BF7 = set_byte(ACopy, BeamFile, 9, 17),
263    verify(not_a_beam_file, beam_lib:info(BF7)),
264
265    BF8 = set_byte(ACopy, BeamFile, 13, 17),
266    verify(missing_chunk, beam_lib:chunks(BF8, ["AtU8"])),
267
268    BF9 = set_byte(ACopy, BeamFile, CompileInfoStart+8, 17),
269    verify(invalid_chunk, beam_lib:chunks(BF9, [compile_info])).
270
271
272%% Compare contents of BEAM files and directories.
273cmp(Conf) when is_list(Conf) ->
274    PrivDir = ?privdir,
275
276    Dir1 = filename:join(PrivDir, "dir1"),
277    Dir2 = filename:join(PrivDir, "dir2"),
278
279    ok = file:make_dir(Dir1),
280    ok = file:make_dir(Dir2),
281
282    {SourceD1, BeamFileD1} = make_beam(Dir1, simple, member),
283    {Source2D1, BeamFile2D1} = make_beam(Dir1, simple2, concat),
284    {SourceD2, BeamFileD2} = make_beam(Dir2, simple, concat),
285
286    NoOfTables = erlang:system_info(ets_count),
287    P0 = pps(),
288
289    %% cmp
290    ok = beam_lib:cmp(BeamFileD1, BeamFileD1),
291    ver(modules_different, beam_lib:cmp(BeamFileD1, BeamFile2D1)),
292    ver(chunks_different, beam_lib:cmp(BeamFileD1, BeamFileD2)),
293    verify(file_error, beam_lib:cmp(foo, bar)),
294
295    {ok, B1} = file:read_file(BeamFileD1),
296    ok = beam_lib:cmp(B1, BeamFileD1),
297    {ok, B2} = file:read_file(BeamFileD2),
298    ver(chunks_different, beam_lib:cmp(B1, B2)),
299
300    %% cmp_dirs
301    {[],[],[]} = beam_lib:cmp_dirs(Dir1, Dir1),
302    true = {[BeamFile2D1], [], [{BeamFileD1,BeamFileD2}]} ==
303	beam_lib:cmp_dirs(Dir1, Dir2),
304    true = {[], [BeamFile2D1], [{BeamFileD2,BeamFileD1}]} ==
305	beam_lib:cmp_dirs(Dir2, Dir1),
306    ver(not_a_directory, beam_lib:cmp_dirs(foo, bar)),
307
308    %% diff_dirs
309    ok = beam_lib:diff_dirs(Dir1, Dir1),
310    ver(not_a_directory, beam_lib:diff_dirs(foo, bar)),
311
312    true = (P0 == pps()),
313    NoOfTables = erlang:system_info(ets_count),
314    delete_files([SourceD1, BeamFileD1, Source2D1,
315		  BeamFile2D1, SourceD2, BeamFileD2]),
316
317    file:del_dir(Dir1),
318    file:del_dir(Dir2),
319    ok.
320
321%% Compare contents of BEAM files having literals.
322cmp_literals(Conf) when is_list(Conf) ->
323    PrivDir = ?privdir,
324
325    Dir1 = filename:join(PrivDir, "dir1"),
326    Dir2 = filename:join(PrivDir, "dir2"),
327
328    ok = file:make_dir(Dir1),
329    ok = file:make_dir(Dir2),
330
331    {SourceD1, BeamFileD1} = make_beam(Dir1, simple, constant),
332    {SourceD2, BeamFileD2} = make_beam(Dir2, simple, constant2),
333
334    NoOfTables = erlang:system_info(ets_count),
335    P0 = pps(),
336
337    %% cmp
338    ok = beam_lib:cmp(BeamFileD1, BeamFileD1),
339    ver(chunks_different, beam_lib:cmp(BeamFileD1, BeamFileD2)),
340
341    {ok, B1} = file:read_file(BeamFileD1),
342    ok = beam_lib:cmp(B1, BeamFileD1),
343    {ok, B2} = file:read_file(BeamFileD2),
344    ver(chunks_different, beam_lib:cmp(B1, B2)),
345
346    true = (P0 == pps()),
347    NoOfTables = erlang:system_info(ets_count),
348
349    delete_files([SourceD1, BeamFileD1, SourceD2, BeamFileD2]),
350
351    file:del_dir(Dir1),
352    file:del_dir(Dir2),
353    ok.
354
355%% Strip BEAM files.
356strip(Conf) when is_list(Conf) ->
357    PrivDir = ?privdir,
358    {SourceD1, BeamFileD1} = make_beam(PrivDir, simple, member),
359    {Source2D1, BeamFile2D1} = make_beam(PrivDir, simple2, concat),
360    {Source3D1, BeamFile3D1} = make_beam(PrivDir, make_fun, make_fun),
361    {Source4D1, BeamFile4D1} = make_beam(PrivDir, constant, constant),
362    {Source5D1, BeamFile5D1} = make_beam(PrivDir, lines, lines),
363
364    NoOfTables = erlang:system_info(ets_count),
365    P0 = pps(),
366
367    %% strip binary
368    verify(not_a_beam_file, beam_lib:strip(<<>>)),
369    {ok, B1} = file:read_file(BeamFileD1),
370    {ok, {simple, NB1}} = beam_lib:strip(B1),
371    BId1 = chunk_ids(B1),
372    NBId1 = chunk_ids(NB1),
373    true = length(BId1) > length(NBId1),
374    compare_chunks(B1, NB1, NBId1),
375
376    %% strip file
377    verify(file_error, beam_lib:strip(foo)),
378    {ok, {simple, _}} = beam_lib:strip(BeamFileD1),
379    compare_chunks(NB1, BeamFileD1, NBId1),
380
381    %% strip_files
382    {ok, B2} = file:read_file(BeamFile2D1),
383    {ok, [{simple,_},{simple2,_}]} = beam_lib:strip_files([B1, B2]),
384    {ok, [{simple,_},{simple2,_},{make_fun,_},{constant,_}]} =
385	beam_lib:strip_files([BeamFileD1, BeamFile2D1, BeamFile3D1, BeamFile4D1]),
386
387    %% check that each module can be loaded.
388    {module, simple} = code:load_abs(filename:rootname(BeamFileD1)),
389    {module, simple2} = code:load_abs(filename:rootname(BeamFile2D1)),
390    {module, make_fun} = code:load_abs(filename:rootname(BeamFile3D1)),
391    {module, constant} = code:load_abs(filename:rootname(BeamFile4D1)),
392
393    %% check that line number information is still present after stripping
394    {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)),
395    {'EXIT',{badarith,[{lines,t,1,Info}|_]}} =
396	(catch lines:t(atom)),
397    true = code:delete(lines),
398    false = code:purge(lines),
399    {ok, {lines,BeamFile5D1}} = beam_lib:strip(BeamFile5D1),
400    {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)),
401    {'EXIT',{badarith,[{lines,t,1,Info}|_]}} =
402	(catch lines:t(atom)),
403
404    true = (P0 == pps()),
405    NoOfTables = erlang:system_info(ets_count),
406
407    delete_files([SourceD1, BeamFileD1,
408		  Source2D1, BeamFile2D1,
409		  Source3D1, BeamFile3D1,
410		  Source4D1, BeamFile4D1,
411		  Source5D1, BeamFile5D1]),
412    ok.
413
414strip_add_chunks(Conf) when is_list(Conf) ->
415    PrivDir = ?privdir,
416    {SourceD1, BeamFileD1} = make_beam(PrivDir, simple, member),
417    {Source2D1, BeamFile2D1} = make_beam(PrivDir, simple2, concat),
418    {Source3D1, BeamFile3D1} = make_beam(PrivDir, make_fun, make_fun),
419    {Source4D1, BeamFile4D1} = make_beam(PrivDir, constant, constant),
420    {Source5D1, BeamFile5D1} = make_beam(PrivDir, lines, lines),
421
422    NoOfTables = erlang:system_info(ets_count),
423    P0 = pps(),
424
425    %% strip binary
426    verify(not_a_beam_file, beam_lib:strip(<<>>)),
427    {ok, B1} = file:read_file(BeamFileD1),
428    {ok, {simple, NB1}} = beam_lib:strip(B1),
429
430    BId1 = chunk_ids(B1),
431    NBId1 = chunk_ids(NB1),
432    true = length(BId1) > length(NBId1),
433    compare_chunks(B1, NB1, NBId1),
434
435    %% Keep all the extra chunks
436    ExtraChunks = ["Abst" , "Dbgi" , "Attr" , "CInf" , "LocT" , "Atom" ],
437    {ok, {simple, AB1}} = beam_lib:strip(B1, ExtraChunks),
438    ABId1 = chunk_ids(AB1),
439    true = length(BId1) == length(ABId1),
440    compare_chunks(B1, AB1, ABId1),
441
442    %% strip file - Keep extra chunks
443    verify(file_error, beam_lib:strip(foo)),
444    {ok, {simple, _}} = beam_lib:strip(BeamFileD1, ExtraChunks),
445    compare_chunks(B1, BeamFileD1, ABId1),
446
447    %% strip_files
448    {ok, B2} = file:read_file(BeamFile2D1),
449    {ok, [{simple,_},{simple2,_}]} = beam_lib:strip_files([B1, B2], ExtraChunks),
450    {ok, [{simple,_},{simple2,_},{make_fun,_},{constant,_}]} =
451	beam_lib:strip_files([BeamFileD1, BeamFile2D1, BeamFile3D1, BeamFile4D1], ExtraChunks),
452
453    %% check that each module can be loaded.
454    {module, simple} = code:load_abs(filename:rootname(BeamFileD1)),
455    {module, simple2} = code:load_abs(filename:rootname(BeamFile2D1)),
456    {module, make_fun} = code:load_abs(filename:rootname(BeamFile3D1)),
457    {module, constant} = code:load_abs(filename:rootname(BeamFile4D1)),
458
459    %% check that line number information is still present after stripping
460    {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)),
461    {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = (catch lines:t(atom)),
462    false = code:purge(lines),
463    true = code:delete(lines),
464    {ok, {lines,BeamFile5D1}} = beam_lib:strip(BeamFile5D1),
465    {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)),
466    {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = (catch lines:t(atom)),
467
468    true = (P0 == pps()),
469    NoOfTables = erlang:system_info(ets_count),
470
471    delete_files([SourceD1, BeamFileD1,
472		  Source2D1, BeamFile2D1,
473		  Source3D1, BeamFile3D1,
474		  Source4D1, BeamFile4D1,
475		  Source5D1, BeamFile5D1]),
476    ok.
477
478otp_6711(Conf) when is_list(Conf) ->
479    {'EXIT',{function_clause,_}} = (catch {a, beam_lib:info(3)}),
480    {'EXIT',{function_clause,_}} = (catch {a, beam_lib:chunks(a, b)}),
481    {'EXIT',{function_clause,_}} = (catch {a, beam_lib:chunks(a,b,c)}),
482    {'EXIT',{function_clause,_}} = (catch {a, beam_lib:all_chunks(3)}),
483    {'EXIT',{function_clause,_}} = (catch {a, beam_lib:cmp(3,4)}),
484    {'EXIT',{function_clause,_}} = (catch {a, beam_lib:strip(3)}),
485    {'EXIT',{function_clause,_}} =
486        (catch {a, beam_lib:strip_files([3])}),
487
488    PrivDir = ?privdir,
489    Dir = filename:join(PrivDir, "dir"),
490    Lib = filename:join(Dir, "lib"),
491    App = filename:join(Lib, "app"),
492    EBin = filename:join(App, "ebin"),
493
494    ok = file:make_dir(Dir),
495    ok = file:make_dir(Lib),
496    ok = file:make_dir(App),
497    ok = file:make_dir(EBin),
498
499    {SourceD, BeamFileD} = make_beam(EBin, simple, member),
500
501    unwritable(BeamFileD),
502
503    %% There is no way that strip_release can fail with
504    %% function_clause or something like that...
505    {error,_,{file_error,_,_}} = beam_lib:strip_release(Dir),
506
507    delete_files([SourceD, BeamFileD]),
508    file:del_dir(EBin),
509    file:del_dir(App),
510    file:del_dir(Lib),
511    file:del_dir(Dir),
512    ok.
513
514-include_lib("kernel/include/file.hrl").
515
516unwritable(Fname) ->
517    {ok, Info} = file:read_file_info(Fname),
518    Mode = Info#file_info.mode - 8#00200,
519    file:write_file_info(Fname, Info#file_info{mode = Mode}).
520
521%% Testing building of BEAM files.
522building(Conf) when is_list(Conf) ->
523    PrivDir = ?privdir,
524
525    Dir1 = filename:join(PrivDir, "b_dir1"),
526    Dir2 = filename:join(PrivDir, "b_dir2"),
527
528    ok = file:make_dir(Dir1),
529    ok = file:make_dir(Dir2),
530
531    {SourceD1, BeamFileD1} = make_beam(Dir1, building, member),
532
533    NoOfTables = erlang:system_info(ets_count),
534    P0 = pps(),
535
536    %% read all chunks
537    ChunkIds = chunk_ids(BeamFileD1),
538    {ok, _Mod, Chunks} = beam_lib:all_chunks(BeamFileD1),
539    ChunkIds = lists:map(fun ({Id, Data}) when is_binary(Data) -> Id
540			 end, Chunks),
541
542    %% write a new beam file, with reversed chunk order
543    BeamFileD2 = filename:join(Dir2, "building.beam"),
544    {ok,RevBeam} = beam_lib:build_module(lists:reverse(Chunks)),
545    file:write_file(BeamFileD2, RevBeam),
546
547    %% compare files
548    compare_chunks(BeamFileD1, BeamFileD2, ChunkIds),
549
550    %% test that we can retrieve a chunk before the atom table
551    %% (actually, try to retrieve all chunks)
552
553    lists:foreach(fun(Id) ->
554			  {ok, {building, [{Id, _Data}]}} =
555			      beam_lib:chunks(BeamFileD1, [Id])
556		  end, ChunkIds),
557    lists:foreach(fun(Id) ->
558			  {ok, {building, [{Id, _Data}]}} =
559			      beam_lib:chunks(BeamFileD2, [Id])
560		  end, ChunkIds),
561
562    true = (P0 == pps()),
563    NoOfTables = erlang:system_info(ets_count),
564
565    delete_files([SourceD1, BeamFileD1, BeamFileD2]),
566    file:del_dir(Dir1),
567    file:del_dir(Dir2),
568    ok.
569
570%% Compare beam_lib:md5/1 and code:module_md5/1.
571md5(Conf) when is_list(Conf) ->
572    Beams = collect_beams(),
573    io:format("Found ~w beam files", [length(Beams)]),
574    md5_1(Beams).
575
576md5_1([N|Ns]) ->
577    {ok,Beam0} = file:read_file(N),
578    Beam = maybe_uncompress(Beam0),
579    {ok,{Mod,MD5}} = beam_lib:md5(Beam),
580    {Mod,MD5} = {Mod,code:module_md5(Beam)},
581    md5_1(Ns);
582md5_1([]) -> ok.
583
584collect_beams() ->
585    SuperDir = filename:dirname(filename:dirname(code:which(?MODULE))),
586    TestDirs = filelib:wildcard(filename:join([SuperDir,"*_test"])),
587    AbsDirs = [filename:absname(X) || X <- code:get_path()],
588    collect_beams_1(AbsDirs ++ TestDirs).
589
590collect_beams_1([Dir|Dirs]) ->
591    filelib:wildcard(filename:join(Dir, "*.beam")) ++ collect_beams_1(Dirs);
592collect_beams_1([]) -> [].
593
594maybe_uncompress(<<"FOR1",_/binary>>=Beam) -> Beam;
595maybe_uncompress(Beam) -> zlib:gunzip(Beam).
596
597%% Test encrypted abstract format.
598encrypted_abstr(Conf) when is_list(Conf) ->
599    run_if_crypto_works(fun() -> encrypted_abstr_1(Conf) end).
600
601encrypted_abstr_1(Conf) ->
602    PrivDir = ?privdir,
603    Simple = filename:join(PrivDir, "simple"),
604    Source = Simple ++ ".erl",
605    BeamFile = Simple ++ ".beam",
606    simple_file(Source),
607
608    %% Avoid getting an extra port when crypto starts erl_ddll.
609    erl_ddll:start(),
610
611    NoOfTables = erlang:system_info(ets_count),
612    P0 = pps(),
613
614    Key = "#a_crypto_key",
615    CompileFlags = [{outdir,PrivDir}, debug_info, {debug_info_key,Key}],
616    {ok,_} = compile:file(Source, CompileFlags),
617    {ok, Binary} = file:read_file(BeamFile),
618
619    do_encrypted_abstr(BeamFile, Key),
620    do_encrypted_abstr(Binary, Key),
621
622    ok = crypto:stop(),			%To get rid of extra ets tables.
623    file:delete(BeamFile),
624    file:delete(Source),
625    NoOfTables = erlang:system_info(ets_count),
626    true = (P0 == pps()),
627    ok.
628
629do_encrypted_abstr(Beam, Key) ->
630    verify(key_missing_or_invalid, beam_lib:chunks(Beam, [debug_info])),
631
632    %% The raw chunk "Dbgi" can still be read even without a key.
633    {ok,{simple,[{"Dbgi",Dbgi}]}} = beam_lib:chunks(Beam, ["Dbgi"]),
634    <<0:8,8:8,"des3_cbc",_/binary>> = Dbgi,
635
636    %% Try som invalid funs.
637    bad_fun(badfun, fun() -> ok end),
638    bad_fun(badfun, {a,b}),
639    bad_fun(blurf),
640    {function_clause,_} = bad_fun(fun(glurf) -> ok end),
641
642    %% Funs that return something strange.
643    bad_fun(badfun, fun(init) -> {ok,fun() -> ok end} end),
644    glurf = bad_fun(fun(init) -> {error,glurf} end),
645
646    %% Try clearing (non-existing fun).
647    undefined = beam_lib:clear_crypto_key_fun(),
648
649    %% Install a fun which cannot retrieve a key.
650    ok = beam_lib:crypto_key_fun(fun(init) -> ok end),
651    {error,beam_lib,Error} = beam_lib:chunks(Beam, [abstract_code]),
652
653    %% Install a fun which returns an incorrect key.
654    {ok,_} = beam_lib:clear_crypto_key_fun(),
655    ok = beam_lib:crypto_key_fun(simple_crypto_fun("wrong key...")),
656    {error,beam_lib,Error} = beam_lib:chunks(Beam, [abstract_code]),
657
658    %% Installing a new key fun is not possible without clearing the old.
659    verify(exists, beam_lib:crypto_key_fun(simple_crypto_fun(Key))),
660
661    %% Install the simplest possible working key fun.
662    {ok,_} = beam_lib:clear_crypto_key_fun(),
663    ok = beam_lib:crypto_key_fun(simple_crypto_fun(Key)),
664    verify_abstract(Beam),
665    {ok,{simple,[{"Dbgi",Dbgi}]}} = beam_lib:chunks(Beam, ["Dbgi"]),
666
667    %% Installing a new key fun is not possible without clearing the old.
668    verify(exists, beam_lib:crypto_key_fun(ets_crypto_fun(Key))),
669
670    %% Install a key using an ets table.
671    {ok,_} = beam_lib:clear_crypto_key_fun(),
672    ok = beam_lib:crypto_key_fun(ets_crypto_fun(Key)),
673    verify_abstract(Beam),
674    {ok,{simple,[{"Dbgi",Dbgi}]}} = beam_lib:chunks(Beam, ["Dbgi"]),
675
676    {ok,cleared} = beam_lib:clear_crypto_key_fun(),
677
678    %% Try to force a stop/start race.
679    start_stop_race(10000),
680
681    ok.
682
683start_stop_race(0) ->
684    ok;
685start_stop_race(N) ->
686    {error,_} = beam_lib:crypto_key_fun(bad_fun),
687    undefined = beam_lib:clear_crypto_key_fun(),
688    start_stop_race(N-1).
689
690bad_fun(F) ->
691    {error,E} = beam_lib:crypto_key_fun(F),
692    E.
693
694bad_fun(S, F) ->
695    verify(S, beam_lib:crypto_key_fun(F)).
696
697verify_abstract(Beam) ->
698    {ok,{simple,[Abst, Dbgi]}} = beam_lib:chunks(Beam, [abstract_code, debug_info]),
699    {abstract_code,{raw_abstract_v1,_}} = Abst,
700    {debug_info,{debug_info_v1,erl_abstract_code,_}} = Dbgi.
701
702simple_crypto_fun(Key) ->
703    fun(init) -> ok;
704       ({debug_info, des3_cbc, simple, _}) -> Key
705    end.
706
707ets_crypto_fun(Key) ->
708    fun(init) ->
709	    T = ets:new(beam_lib_SUITE_keys, [private, set]),
710	    true = ets:insert(T, {key,Key}),
711	    {ok,fun({debug_info, des3_cbc, simple, _}) ->
712			[{key,Val}] = ets:lookup(T, key),
713			Val;
714		   (clear) ->
715			ets:delete(T),
716			cleared
717		end}
718    end.
719
720%% Test encrypted abstract format with the key in .erlang.crypt.
721encrypted_abstr_file(Conf) when is_list(Conf) ->
722    run_if_crypto_works(fun() -> encrypted_abstr_file_1(Conf) end).
723
724encrypted_abstr_file_1(Conf) ->
725    PrivDir = ?privdir,
726    Simple = filename:join(PrivDir, "simple"),
727    Source = Simple ++ ".erl",
728    BeamFile = Simple ++ ".beam",
729    simple_file(Source),
730
731    %% Avoid getting an extra port when crypto starts erl_ddll.
732    erl_ddll:start(),
733
734    NoOfTables = erlang:system_info(ets_count),
735    P0 = pps(),
736
737    Key = "Long And niCe 99Krypto Key",
738    CompileFlags = [{outdir,PrivDir}, debug_info, {debug_info_key,Key}],
739    {ok,_} = compile:file(Source, CompileFlags),
740    {ok, Binary} = file:read_file(BeamFile),
741
742    {ok,OldCwd} = file:get_cwd(),
743    ok = file:set_cwd(PrivDir),
744    do_encrypted_abstr_file(BeamFile, Key),
745    do_encrypted_abstr_file(Binary, Key),
746    ok = file:set_cwd(OldCwd),
747
748    ok = crypto:stop(),			%To get rid of extra ets tables.
749    file:delete(filename:join(PrivDir, ".erlang.crypt")),
750    file:delete(BeamFile),
751    file:delete(Source),
752    NoOfTables = erlang:system_info(ets_count),
753    true = (P0 == pps()),
754    ok.
755
756do_encrypted_abstr_file(Beam, Key) ->
757    %% No key.
758    write_crypt_file(""),
759    {error,beam_lib,Error} = beam_lib:chunks(Beam, [abstract_code]),
760
761    %% A wrong key.
762    write_crypt_file(["[{debug_info,des3_cbc,simple,\"A Wrong Key\"}].\n"]),
763    {error,beam_lib,Error} = beam_lib:chunks(Beam, [abstract_code]),
764
765    %% Write correct key...
766    write_crypt_file(["[{debug_info,des3_cbc,simple,\"",Key,"\"}].\n"]),
767
768    %% ... but the fun with the wrong key is still there.
769    {error,beam_lib,Error} = beam_lib:chunks(Beam, [abstract_code]),
770
771    %% Clear the fun. Now it should work.
772    {ok,_} = beam_lib:clear_crypto_key_fun(),
773    verify_abstract(Beam),
774    verify_abstract(Beam),
775    ok = file:delete(".erlang.crypt"),
776    verify_abstract(Beam),
777
778    %% Clear, otherwise the second pass will fail.
779    {ok,_} = beam_lib:clear_crypto_key_fun(),
780    {error,beam_lib,Error} = beam_lib:chunks(Beam, [abstract_code]),
781    ok.
782
783test_makedep_abstract_code(Conf) ->
784    PrivDir = ?privdir,
785    ErlFile = filename:join(PrivDir, "hello.erl"),
786    BeamFile = filename:join(PrivDir, "hello.beam"),
787    file:write_file(ErlFile,
788		    ["-module(hello).\n",
789		     "-export([start/0]).\n",
790		     "start() -> ok.\n"
791		    ]),
792    DependDir = filename:join(PrivDir, "depend"),
793    file:make_dir(DependDir),
794    DependFile = filename:join(DependDir,"hello.d"),
795    compile:file(ErlFile,
796		 [debug_info,
797		  makedep_side_effect,
798		  {outdir, PrivDir},
799		  {makedep_output, DependFile}]),
800    file:delete(DependFile),
801    file:del_dir(DependDir),
802    case beam_lib:chunks(BeamFile, [debug_info]) of
803	{ok, {Module, [{debug_info, {debug_info_v1,
804				     _Backend=erl_abstract_code,Metadata}}]}} ->
805	    SrcOpts = [no_copt, to_core, binary, return_errors,
806		       no_inline, strict_record_tests, strict_record_updates,
807		       dialyzer, no_spawn_compiler_process],
808	    {ok,_} = erl_abstract_code:debug_info(core_v1, Module, Metadata,
809						  SrcOpts),
810            ok
811    end.
812
813
814write_crypt_file(Contents0) ->
815    Contents = list_to_binary([Contents0]),
816    io:format("~s\n", [binary_to_list(Contents)]),
817    ok = file:write_file(".erlang.crypt", Contents).
818
819%% GH-4353: Don't crash when the backend for generating the abstract code
820%% is missing.
821missing_debug_info_backend(Conf) ->
822    PrivDir = ?privdir,
823    Simple = filename:join(PrivDir, "simple"),
824    Source = Simple ++ ".erl",
825    BeamFile = Simple ++ ".beam",
826    simple_file(Source),
827
828    %% Create a debug_info chunk with a non-existing backend.
829    {ok,simple} = compile:file(Source, [{outdir,PrivDir}]),
830    {ok,simple,All0} = beam_lib:all_chunks(BeamFile),
831    FakeBackend = definitely__not__an__existing__backend,
832    FakeDebugInfo = {debug_info_v1, FakeBackend, nothing_here},
833    All = lists:keyreplace("Dbgi", 1, All0, {"Dbgi", term_to_binary(FakeDebugInfo)}),
834    {ok,NewBeam} = beam_lib:build_module(All),
835    ok = file:write_file(BeamFile, NewBeam),
836
837    %% beam_lib should not crash, but return an error.
838    verify(missing_backend, beam_lib:chunks(BeamFile, [abstract_code])),
839    file:delete(BeamFile),
840
841    ok.
842
843compare_chunks(File1, File2, ChunkIds) ->
844    {ok, {_, Chunks1}} = beam_lib:chunks(File1, ChunkIds),
845    {ok, {_, Chunks2}} = beam_lib:chunks(File2, ChunkIds),
846    true = Chunks1 == Chunks2.
847
848chunk_ids(File) ->
849    lists:map(fun({Id,_Start,_Size}) -> Id end, chunk_info(File)).
850
851chunk_info(File) ->
852    {value, {chunks, Chunks}} =
853	lists:keysearch(chunks, 1, beam_lib:info(File)),
854    Chunks.
855
856make_beam(Dir, Module, F) ->
857    FileBase = filename:join(Dir, atom_to_list(Module)),
858    Source = FileBase ++ ".erl",
859    BeamFile = FileBase ++ ".beam",
860    file:delete(BeamFile),
861    simple_file(Source, Module, F),
862    {ok, _} = compile:file(Source, [{outdir,Dir}, debug_info, report]),
863    {Source, BeamFile}.
864
865set_byte(_Backup, Binary, Pos, Byte) when is_binary(Binary) ->
866    <<B1:Pos/binary, _:1/binary, B2/binary>> = Binary,
867    NB = <<B1/binary, Byte:8, B2/binary>>,
868    NB;
869set_byte(Backup, File, Pos, Byte) ->
870    copy_file(Backup, File),
871    set_byte(File, Pos, Byte),
872    File.
873
874set_byte(File, Pos, Byte) ->
875    {ok, Fd} = file:open(File, [read, write]),
876    {ok, _} = file:position(Fd, Pos),
877    ok = file:write(Fd, [Byte]),
878    file:close(Fd).
879
880copy_file(Src, Dest) ->
881    {ok, _} = file:copy(Src, Dest),
882    ok = file:change_mode(Dest, 8#0666).
883
884delete_files(Files) ->
885    lists:foreach(fun(F) -> file:delete(F) end, Files).
886
887verify(S, {error, beam_lib, R}) ->
888    verify_error(S, R);
889verify(S, {error, R}) ->
890    verify_error(S, R).
891
892verify_error(S, R) ->
893    if
894	S =:= R -> ok;
895	true -> [S|_] = tuple_to_list(R)
896    end,
897
898    %% Most formatted messages begin with "./simple.beam:" or "<<...".
899    FM = string:str(lists:flatten(beam_lib:format_error(R)), "simpl") > 0,
900    BM = string:str(lists:flatten(beam_lib:format_error(R)), "<<") > 0,
901
902    %% Also make sure that formatted message is not just the term printed.
903    Handled = beam_lib:format_error(R) =/= io_lib:format("~p~n", [R]),
904    true = ((FM > 0) or (BM > 0)) and Handled.
905
906ver(S, {error, beam_lib, R}) ->
907    [S|_] = tuple_to_list(R),
908    case lists:flatten(beam_lib:format_error(R)) of
909	[${ | _] ->
910	    ct:fail({bad_format_error, R});
911	_ ->
912	    ok
913    end.
914
915pps() ->
916    {erlang:ports()}.
917
918simple_file(File) ->
919    simple_file(File, simple).
920
921simple_file(File, Module) ->
922    simple_file(File, Module, member).
923
924simple_file(File, Module, make_fun) ->
925    B = list_to_binary(["-module(", atom_to_list(Module), "). "
926			"-export([t/1]). "
927			"t(A) -> "
928			"    fun(X) -> A+X end. "]),
929    ok = file:write_file(File, B);
930simple_file(File, Module, constant) ->
931    B = list_to_binary(["-module(", atom_to_list(Module), "). "
932			"-export([t/1]). "
933			"t(A) -> "
934			"    {a,b,[2,3],c,d}. "]),
935    ok = file:write_file(File, B);
936simple_file(File, Module, constant2) ->
937    B = list_to_binary(["-module(", atom_to_list(Module), "). "
938			"-export([t/1]). "
939			"t(A) -> "
940			"    {a,b,[2,3],x,y}. "]),
941    ok = file:write_file(File, B);
942simple_file(File, Module, lines) ->
943    B = list_to_binary(["-module(", atom_to_list(Module), ").\n"
944			"-export([t/1]).\n"
945			"t(A) ->\n"
946			"    A+1.\n"]),
947    ok = file:write_file(File, B);
948simple_file(File, Module, F) ->
949    B = list_to_binary(["-module(", atom_to_list(Module), "). "
950			"-export([t/0]). "
951			"t() -> "
952			"    t([]). "
953			"t(L) -> "
954			"    lists:",
955			atom_to_list(F), "(a, L). "]),
956    ok = file:write_file(File, B).
957
958run_if_crypto_works(Test) ->
959    try	begin crypto:start(), crypto:stop(), ok end of
960	ok ->
961	    Test()
962    catch
963	error:_ ->
964	    {skip,"The crypto application is missing or broken"}
965    end.
966
967