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