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