1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2000-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).
21-behaviour(gen_server).
22
23%% Avoid warning for local function error/1 clashing with autoimported BIF.
24-compile({no_auto_import,[error/1]}).
25%% Avoid warning for local function error/2 clashing with autoimported BIF.
26-compile({no_auto_import,[error/2]}).
27-export([info/1,
28	 cmp/2,
29	 cmp_dirs/2,
30	 chunks/2,
31	 chunks/3,
32	 all_chunks/1,
33	 diff_dirs/2,
34	 strip/1,
35	 strip/2,
36	 strip_files/1,
37	 strip_files/2,
38	 strip_release/1,
39	 strip_release/2,
40	 significant_chunks/0,
41	 build_module/1,
42	 version/1,
43	 md5/1,
44	 format_error/1]).
45
46%% The following functions implement encrypted debug info.
47
48-export([crypto_key_fun/1, clear_crypto_key_fun/0]).
49-export([init/1,handle_call/3,handle_cast/2,handle_info/2,
50	 terminate/2,code_change/3]).
51-export([make_crypto_key/2, get_crypto_key/1]).	%Utilities used by compiler
52
53-export_type([attrib_entry/0, compinfo_entry/0, labeled_entry/0, label/0]).
54
55-import(lists, [append/1, delete/2, foreach/2, keysort/2,
56		member/2, reverse/1, sort/1, splitwith/2]).
57
58%%-------------------------------------------------------------------------
59
60-type beam() :: file:filename() | binary().
61-type debug_info() :: {DbgiVersion :: atom(), Backend :: module(), Data :: term()} | 'no_debug_info'.
62
63-type forms()     :: [erl_parse:abstract_form() | erl_parse:form_info()].
64
65-type abst_code() :: {AbstVersion :: atom(), forms()} | 'no_abstract_code'.
66-type dataB()     :: binary().
67-type index()     :: non_neg_integer().
68-type label()     :: integer().
69
70-type chunkid()   :: nonempty_string(). % approximation of the strings below
71%% "Abst" | "Dbgi" | "Attr" | "CInf" | "ExpT" | "ImpT" | "LocT" | "Atom" | "AtU8".
72-type chunkname() :: 'abstract_code' | 'debug_info'
73                   | 'attributes' | 'compile_info'
74                   | 'exports' | 'labeled_exports'
75                   | 'imports' | 'indexed_imports'
76                   | 'locals' | 'labeled_locals'
77                   | 'atoms'.
78-type chunkref()  :: chunkname() | chunkid().
79
80-type attrib_entry()   :: {Attribute :: atom(), [AttributeValue :: term()]}.
81-type compinfo_entry() :: {InfoKey :: atom(), term()}.
82-type labeled_entry()  :: {Function :: atom(), arity(), label()}.
83
84-type chunkdata() :: {chunkid(), dataB()}
85                   | {'abstract_code', abst_code()}
86                   | {'debug_info', debug_info()}
87                   | {'attributes', [attrib_entry()]}
88                   | {'compile_info', [compinfo_entry()]}
89                   | {'exports', [{atom(), arity()}]}
90                   | {'labeled_exports', [labeled_entry()]}
91                   | {'imports', [mfa()]}
92                   | {'indexed_imports', [{index(), module(), Function :: atom(), arity()}]}
93                   | {'locals', [{atom(), arity()}]}
94                   | {'labeled_locals', [labeled_entry()]}
95                   | {'atoms', [{integer(), atom()}]}.
96
97%% Error reasons
98-type info_rsn()  :: {'chunk_too_big', file:filename(),
99		      chunkid(), ChunkSize :: non_neg_integer(),
100                      FileSize :: non_neg_integer()}
101                   | {'invalid_beam_file', file:filename(),
102                      Position :: non_neg_integer()}
103                   | {'invalid_chunk', file:filename(), chunkid()}
104                   | {'missing_chunk', file:filename(), chunkid()}
105                   | {'not_a_beam_file', file:filename()}
106                   | {'file_error', file:filename(), file:posix()}.
107-type chnk_rsn()  :: {'unknown_chunk', file:filename(), atom()}
108                   | {'key_missing_or_invalid', file:filename(),
109		      'abstract_code' | 'debug_info'}
110                   | {'missing_backend', file:filename(), module()}
111                   | info_rsn().
112-type cmp_rsn()   :: {'modules_different', module(), module()}
113                   | {'chunks_different', chunkid()}
114                   | 'different_chunks'
115                   | info_rsn().
116
117%%-------------------------------------------------------------------------
118
119%%
120%%  Exported functions
121%%
122
123-spec info(Beam) -> [InfoPair] | {'error', 'beam_lib', info_rsn()} when
124      Beam :: beam(),
125      InfoPair :: {'file', Filename :: file:filename()}
126                | {'binary', Binary :: binary()}
127                | {'module', Module :: module()}
128                | {'chunks', [{ChunkId :: chunkid(),
129                               Pos :: non_neg_integer(),
130                               Size :: non_neg_integer()}]}.
131
132info(File) ->
133    read_info(beam_filename(File)).
134
135-spec chunks(Beam, ChunkRefs) ->
136                    {'ok', {module(), [chunkdata()]}} |
137                    {'error', 'beam_lib', chnk_rsn()} when
138      Beam :: beam(),
139      ChunkRefs :: [chunkref()].
140
141chunks(File, Chunks) ->
142    read_chunk_data(File, Chunks).
143
144-spec chunks(Beam, ChunkRefs, Options) ->
145                    {'ok', {module(), [ChunkResult]}} |
146                    {'error', 'beam_lib', chnk_rsn()} when
147      Beam :: beam(),
148      ChunkRefs :: [chunkref()],
149      Options :: ['allow_missing_chunks'],
150      ChunkResult :: chunkdata() | {ChunkRef :: chunkref(), 'missing_chunk'}.
151
152chunks(File, Chunks, Options) ->
153    try read_chunk_data(File, Chunks, Options)
154    catch Error -> Error end.
155
156-spec all_chunks(beam()) ->
157           {'ok', 'beam_lib', [{chunkid(), dataB()}]} | {'error', 'beam_lib', info_rsn()}.
158
159all_chunks(File) ->
160    read_all_chunks(File).
161
162-spec cmp(Beam1, Beam2) -> 'ok' | {'error', 'beam_lib', cmp_rsn()} when
163      Beam1 :: beam(),
164      Beam2 :: beam().
165
166cmp(File1, File2) ->
167    try cmp_files(File1, File2)
168    catch Error -> Error end.
169
170-spec cmp_dirs(Dir1, Dir2) ->
171           {Only1, Only2, Different} | {'error', 'beam_lib', Reason} when
172      Dir1 :: atom() | file:filename(),
173      Dir2 :: atom() | file:filename(),
174      Only1 :: [file:filename()],
175      Only2 :: [file:filename()],
176      Different :: [{Filename1 :: file:filename(), Filename2 :: file:filename()}],
177      Reason :: {'not_a_directory', term()} | info_rsn().
178
179cmp_dirs(Dir1, Dir2) ->
180    catch compare_dirs(Dir1, Dir2).
181
182-spec diff_dirs(Dir1, Dir2) -> 'ok' | {'error', 'beam_lib', Reason} when
183      Dir1 :: atom() | file:filename(),
184      Dir2 :: atom() | file:filename(),
185      Reason :: {'not_a_directory', term()} | info_rsn().
186
187diff_dirs(Dir1, Dir2) ->
188    catch diff_directories(Dir1, Dir2).
189
190-spec strip(Beam1) ->
191        {'ok', {module(), Beam2}} | {'error', 'beam_lib', info_rsn()} when
192      Beam1 :: beam(),
193      Beam2 :: beam().
194
195strip(FileName) ->
196    strip(FileName, []).
197
198-spec strip(Beam1, AdditionalChunks) ->
199        {'ok', {module(), Beam2}} | {'error', 'beam_lib', info_rsn()} when
200      Beam1 :: beam(),
201      AdditionalChunks :: [chunkid()],
202      Beam2 :: beam().
203
204strip(FileName, AdditionalChunks) ->
205    try strip_file(FileName, AdditionalChunks)
206    catch Error -> Error end.
207
208-spec strip_files(Files) ->
209        {'ok', [{module(), Beam}]} | {'error', 'beam_lib', info_rsn()} when
210      Files :: [beam()],
211      Beam :: beam().
212
213strip_files(Files) ->
214    strip_files(Files, []).
215
216-spec strip_files(Files, AdditionalChunks) ->
217        {'ok', [{module(), Beam}]} | {'error', 'beam_lib', info_rsn()} when
218      Files :: [beam()],
219      AdditionalChunks :: [chunkid()],
220      Beam :: beam().
221
222strip_files(Files, AdditionalChunks) when is_list(Files) ->
223    try strip_fils(Files, AdditionalChunks)
224    catch Error -> Error end.
225
226-spec strip_release(Dir) ->
227        {'ok', [{module(), file:filename()}]}
228      | {'error', 'beam_lib', Reason} when
229      Dir :: atom() | file:filename(),
230      Reason :: {'not_a_directory', term()} | info_rsn().
231
232strip_release(Root) ->
233    strip_release(Root, []).
234
235-spec strip_release(Dir, AdditionalChunks) ->
236        {'ok', [{module(), file:filename()}]}
237      | {'error', 'beam_lib', Reason} when
238      Dir :: atom() | file:filename(),
239      AdditionalChunks :: [chunkid()],
240      Reason :: {'not_a_directory', term()} | info_rsn().
241
242strip_release(Root, AdditionalChunks) ->
243    catch strip_rel(Root, AdditionalChunks).
244
245-spec version(Beam) ->
246                     {'ok', {module(), [Version :: term()]}} |
247                     {'error', 'beam_lib', chnk_rsn()} when
248      Beam :: beam().
249
250version(File) ->
251    case catch read_chunk_data(File, [attributes]) of
252	{ok, {Module, [{attributes, Attrs}]}} ->
253	    {vsn, Version} = lists:keyfind(vsn, 1, Attrs),
254	    {ok, {Module, Version}};
255	Error ->
256	    Error
257    end.
258
259-spec md5(Beam) ->
260        {'ok', {module(), MD5}} | {'error', 'beam_lib', chnk_rsn()} when
261      Beam :: beam(),
262      MD5 :: binary().
263
264md5(File) ->
265    case catch read_significant_chunks(File, md5_chunks()) of
266	{ok, {Module, Chunks0}} ->
267	    Chunks = filter_funtab(Chunks0),
268	    {ok, {Module, erlang:md5([C || {_Id, C} <- Chunks])}};
269	Error ->
270	    Error
271    end.
272
273-spec format_error(Reason) -> io_lib:chars() when
274      Reason :: term().
275
276format_error({error, Error}) ->
277    format_error(Error);
278format_error({error, Module, Error}) ->
279    Module:format_error(Error);
280format_error({unknown_chunk, File, ChunkName}) ->
281    io_lib:format("~tp: Cannot find chunk ~p~n", [File, ChunkName]);
282format_error({invalid_chunk, File, ChunkId}) ->
283    io_lib:format("~tp: Invalid contents of chunk ~p~n", [File, ChunkId]);
284format_error({not_a_beam_file, File}) ->
285    io_lib:format("~tp: Not a BEAM file~n", [File]);
286format_error({file_error, File, Reason}) ->
287    io_lib:format("~tp: ~tp~n", [File, file:format_error(Reason)]);
288format_error({missing_chunk, File, ChunkId}) ->
289    io_lib:format("~tp: Not a BEAM file: no IFF \"~s\" chunk~n",
290		  [File, ChunkId]);
291format_error({invalid_beam_file, File, Pos}) ->
292    io_lib:format("~tp: Invalid format of BEAM file near byte number ~p~n",
293		  [File, Pos]);
294format_error({chunk_too_big, File, ChunkId, Size, Len}) ->
295    io_lib:format("~tp: Size of chunk \"~s\" is ~p bytes, "
296		  "but only ~p bytes could be read~n",
297		  [File, ChunkId, Size, Len]);
298format_error({chunks_different, Id}) ->
299    io_lib:format("Chunk \"~s\" differs in the two files~n", [Id]);
300format_error(different_chunks) ->
301    "The two files have different chunks\n";
302format_error({modules_different, Module1, Module2}) ->
303    io_lib:format("Module names ~p and ~p differ in the two files~n",
304		  [Module1, Module2]);
305format_error({not_a_directory, Name}) ->
306    io_lib:format("~tp: Not a directory~n", [Name]);
307format_error({key_missing_or_invalid, File, ChunkId}) ->
308    io_lib:format("~tp: Cannot decrypt ~ts because key is missing or invalid",
309		  [File, ChunkId]);
310format_error(badfun) ->
311    "not a fun or the fun has the wrong arity";
312format_error(exists) ->
313    "a fun has already been installed";
314format_error({missing_backend, File, Backend}) ->
315    io_lib:format("~tp: Cannot retrieve abstract code because the backend ~p is missing",
316		  [File, Backend]);
317format_error(E) ->
318    io_lib:format("~tp~n", [E]).
319
320%%
321%% Exported functions for encrypted debug info.
322%%
323
324-type mode()           :: 'des3_cbc'.
325-type crypto_fun_arg() :: 'init'
326                        | 'clear'
327                        | {'debug_info', mode(), module(), file:filename()}.
328-type crypto_fun()     :: fun((crypto_fun_arg()) -> term()).
329
330-spec crypto_key_fun(CryptoKeyFun) -> 'ok' | {'error', Reason} when
331      CryptoKeyFun :: crypto_fun(),
332      Reason :: badfun | exists | term().
333
334crypto_key_fun(F) ->
335    call_crypto_server({crypto_key_fun, F}).
336
337-spec clear_crypto_key_fun() -> 'undefined' | {'ok', Result} when
338      Result :: 'undefined' | term().
339
340clear_crypto_key_fun() ->
341    call_crypto_server(clear_crypto_key_fun).
342
343-spec make_crypto_key(mode(), string()) ->
344        {mode(), [binary()], binary(), integer()}.
345
346make_crypto_key(des3_cbc=Type, String) ->
347    <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String),
348    <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|reverse(String)]),
349    {Type,[K1,K2,K3],IVec,8}.
350
351-spec build_module(Chunks) -> {'ok', Binary} when
352      Chunks :: [{chunkid(), dataB()}],
353      Binary :: binary().
354
355build_module(Chunks0) ->
356    Chunks = list_to_binary(build_chunks(Chunks0)),
357    Size = byte_size(Chunks),
358    0 = Size rem 4, % Assertion: correct padding?
359    {ok, <<"FOR1", (Size+4):32, "BEAM", Chunks/binary>>}.
360
361
362%%
363%%  Local functions
364%%
365
366read_info(File) ->
367    try
368        {ok, Module, Data} = scan_beam(File, info),
369        [if
370             is_binary(File) -> {binary, File};
371             true -> {file, File}
372         end, {module, Module}, {chunks, Data}]
373    catch Error -> Error end.
374
375diff_directories(Dir1, Dir2) ->
376    {OnlyDir1, OnlyDir2, Diff} = compare_dirs(Dir1, Dir2),
377    diff_only(Dir1, OnlyDir1),
378    diff_only(Dir2, OnlyDir2),
379    foreach(fun(D) -> io:format("** different: ~tp~n", [D]) end, Diff),
380    ok.
381
382diff_only(_Dir, []) ->
383    ok;
384diff_only(Dir, Only) ->
385    io:format("Only in ~tp: ~tp~n", [Dir, Only]).
386
387%% -> {OnlyInDir1, OnlyInDir2, Different} | throw(Error)
388compare_dirs(Dir1, Dir2) ->
389    R1 = sofs:relation(beam_files(Dir1)),
390    R2 = sofs:relation(beam_files(Dir2)),
391    F1 = sofs:domain(R1),
392    F2 = sofs:domain(R2),
393    {O1, Both, O2} = sofs:symmetric_partition(F1, F2),
394    OnlyL1 = sofs:image(R1, O1),
395    OnlyL2 = sofs:image(R2, O2),
396    B1 = sofs:to_external(sofs:restriction(R1, Both)),
397    B2 = sofs:to_external(sofs:restriction(R2, Both)),
398    Diff = compare_files(B1, B2, []),
399    {sofs:to_external(OnlyL1), sofs:to_external(OnlyL2), Diff}.
400
401compare_files([], [], Acc) ->
402    lists:reverse(Acc);
403compare_files([{_,F1} | R1], [{_,F2} | R2], Acc) ->
404    NAcc = case catch cmp_files(F1, F2) of
405	       {error, _Mod, _Reason} ->
406		   [{F1, F2} | Acc];
407	       ok ->
408		   Acc
409	   end,
410    compare_files(R1, R2, NAcc).
411
412beam_files(Dir) ->
413    ok = assert_directory(Dir),
414    L = filelib:wildcard(filename:join(Dir, "*.beam")),
415    [{filename:basename(Path), Path} || Path <- L].
416
417%% -> ok | throw(Error)
418cmp_files(File1, File2) ->
419    {ok, {M1, L1}} = read_all_but_useless_chunks(File1),
420    {ok, {M2, L2}} = read_all_but_useless_chunks(File2),
421    if
422	M1 =:= M2 ->
423	    cmp_lists(L1, L2);
424	true ->
425	    error({modules_different, M1, M2})
426    end.
427
428cmp_lists([], []) ->
429    ok;
430cmp_lists([{Id, C1} | R1], [{Id, C2} | R2]) ->
431    if
432	C1 =:= C2 ->
433	    cmp_lists(R1, R2);
434	true ->
435	    error({chunks_different, Id})
436    end;
437cmp_lists(_, _) ->
438    error(different_chunks).
439
440strip_rel(Root, AdditionalChunks) ->
441    ok = assert_directory(Root),
442    strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam")), AdditionalChunks).
443
444%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error)
445strip_fils(Files, AdditionalChunks) ->
446    {ok, [begin {ok, Reply} = strip_file(F, AdditionalChunks), Reply end || F <- Files]}.
447
448%% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error)
449strip_file(File, AdditionalChunks) ->
450    {ok, {Mod, Chunks}} = read_significant_chunks(File, AdditionalChunks ++ significant_chunks()),
451    {ok, Stripped0} = build_module(Chunks),
452    Stripped = compress(Stripped0),
453    case File of
454	_ when is_binary(File) ->
455	    {ok, {Mod, Stripped}};
456	_ ->
457	    FileName = beam_filename(File),
458	    case file:open(FileName, [raw, binary, write]) of
459		{ok, Fd} ->
460		    case file:write(Fd, Stripped) of
461			ok ->
462			    ok = file:close(Fd),
463			    {ok, {Mod, FileName}};
464			Error ->
465			    ok = file:close(Fd),
466			    file_error(FileName, Error)
467		    end;
468		Error ->
469		    file_error(FileName, Error)
470	    end
471    end.
472
473build_chunks([{Id, Data} | Chunks]) ->
474    BId = list_to_binary(Id),
475    Size = byte_size(Data),
476    Chunk = [<<BId/binary, Size:32>>, Data | pad(Size)],
477    [Chunk | build_chunks(Chunks)];
478build_chunks([]) ->
479    [].
480
481pad(Size) ->
482    case Size rem 4 of
483	0 -> [];
484	Rem -> lists:duplicate(4 - Rem, 0)
485    end.
486
487%% -> {ok, {Module, Chunks}} | throw(Error)
488read_all_but_useless_chunks(File0) when is_atom(File0);
489					is_list(File0);
490					is_binary(File0) ->
491    File = beam_filename(File0),
492    {ok, Module, ChunkIds0} = scan_beam(File, info),
493    ChunkIds = [Name || {Name,_,_} <- ChunkIds0,
494			not is_useless_chunk(Name)],
495    {ok, Module, Chunks} = scan_beam(File, ChunkIds),
496    {ok, {Module, lists:reverse(Chunks)}}.
497
498is_useless_chunk("CInf") -> true;
499is_useless_chunk(_) -> false.
500
501%% -> {ok, {Module, Chunks}} | throw(Error)
502read_significant_chunks(File, ChunkList) ->
503    case read_chunk_data(File, ChunkList, [allow_missing_chunks]) of
504	{ok, {Module, Chunks0}} ->
505	    Mandatory = mandatory_chunks(),
506	    Chunks = filter_significant_chunks(Chunks0, Mandatory, File, Module),
507	    {ok, {Module, Chunks}}
508    end.
509
510filter_significant_chunks([{_, Data}=Pair|Cs], Mandatory, File, Mod)
511  when is_binary(Data) ->
512    [Pair|filter_significant_chunks(Cs, Mandatory, File, Mod)];
513filter_significant_chunks([{Id, missing_chunk}|Cs], Mandatory, File, Mod) ->
514    case member(Id, Mandatory) of
515	false ->
516	    filter_significant_chunks(Cs, Mandatory, File, Mod);
517	true ->
518	    error({missing_chunk, File, Id})
519    end;
520filter_significant_chunks([], _, _, _) -> [].
521
522filter_funtab([{"FunT"=Tag, <<L:4/binary, Data0/binary>>}|Cs]) ->
523    Data = filter_funtab_1(Data0, <<0:32>>),
524    Funtab = <<L/binary, (iolist_to_binary(Data))/binary>>,
525    [{Tag, Funtab}|filter_funtab(Cs)];
526filter_funtab([H|T]) ->
527    [H|filter_funtab(T)];
528filter_funtab([]) -> [].
529
530filter_funtab_1(<<Important:20/binary,_OldUniq:4/binary,T/binary>>, Zero) ->
531    [Important,Zero|filter_funtab_1(T, Zero)];
532filter_funtab_1(Tail, _) when is_binary(Tail) -> [Tail].
533
534read_all_chunks(File0) when is_atom(File0);
535			    is_list(File0);
536			    is_binary(File0) ->
537    try
538        File = beam_filename(File0),
539        {ok, Module, ChunkIds0} = scan_beam(File, info),
540        ChunkIds = [Name || {Name,_,_} <- ChunkIds0],
541        {ok, Module, Chunks} = scan_beam(File, ChunkIds),
542        {ok, Module, lists:reverse(Chunks)}
543    catch Error -> Error end.
544
545read_chunk_data(File0, ChunkNames) ->
546    try read_chunk_data(File0, ChunkNames, [])
547    catch Error -> Error end.
548
549%% -> {ok, {Module, Symbols}} | throw(Error)
550read_chunk_data(File0, ChunkNames0, Options)
551  when is_atom(File0); is_list(File0); is_binary(File0) ->
552    File = beam_filename(File0),
553    {ChunkIds, Names, Optional} = check_chunks(ChunkNames0, File, [], [], []),
554    AllowMissingChunks = member(allow_missing_chunks, Options),
555    {ok, Module, Chunks} = scan_beam(File, ChunkIds, AllowMissingChunks, Optional),
556    AT = ets:new(beam_symbols, []),
557    T = {empty, AT},
558    try chunks_to_data(Names, Chunks, File, Chunks, Module, T, [])
559    after ets:delete(AT)
560    end.
561
562%% -> {ok, list()} | throw(Error)
563check_chunks([atoms | Ids], File, IL, L, O) ->
564    check_chunks(Ids, File, ["Atom", "AtU8" | IL],
565		 [{atom_chunk, atoms} | L], ["Atom", "AtU8" | O]);
566check_chunks([abstract_code | Ids], File, IL, L, O) ->
567    check_chunks(Ids, File, ["Abst", "Dbgi" | IL],
568		 [{abst_chunk, abstract_code} | L], ["Abst", "Dbgi" | O]);
569check_chunks([ChunkName | Ids], File, IL, L, O) when is_atom(ChunkName) ->
570    ChunkId = chunk_name_to_id(ChunkName, File),
571    check_chunks(Ids, File, [ChunkId | IL], [{ChunkId, ChunkName} | L], O);
572check_chunks([ChunkId | Ids], File, IL, L, O) -> % when is_list(ChunkId)
573    check_chunks(Ids, File, [ChunkId | IL], [{ChunkId, ChunkId} | L], O);
574check_chunks([], _File, IL, L, O) ->
575    {lists:usort(IL), reverse(L), O}.
576
577%% -> {ok, Module, Data} | throw(Error)
578scan_beam(File, What) ->
579    scan_beam(File, What, false, []).
580
581%% -> {ok, Module, Data} | throw(Error)
582scan_beam(File, What0, AllowMissingChunks, OptionalChunks) ->
583    case scan_beam1(File, What0) of
584	{missing, _FD, Mod, Data, What} when AllowMissingChunks ->
585	    {ok, Mod, [{Id, missing_chunk} || Id <- What] ++ Data};
586	{missing, FD, Mod, Data, What} ->
587	    case What -- OptionalChunks of
588		[] -> {ok, Mod, Data};
589		[Missing | _] -> error({missing_chunk, filename(FD), Missing})
590	    end;
591	R ->
592	    R
593    end.
594
595%% -> {ok, Module, Data} | throw(Error)
596scan_beam1(File, What) ->
597    FD = open_file(File),
598    case catch scan_beam2(FD, What) of
599	Error when error =:= element(1, Error) ->
600	    throw(Error);
601	R ->
602	    R
603    end.
604
605scan_beam2(FD, What) ->
606    case pread(FD, 0, 12) of
607	{NFD, {ok, <<"FOR1", _Size:32, "BEAM">>}} ->
608	    Start = 12,
609	    scan_beam(NFD, Start, What, 17, []);
610	_Error ->
611	    error({not_a_beam_file, filename(FD)})
612    end.
613
614scan_beam(_FD, _Pos, [], Mod, Data) when Mod =/= 17 ->
615    {ok, Mod, Data};
616scan_beam(FD, Pos, What, Mod, Data) ->
617    case pread(FD, Pos, 8) of
618	{_NFD, eof} when Mod =:= 17 ->
619	    error({missing_chunk, filename(FD), "Atom"});
620	{_NFD, eof} when What =:= info ->
621	    {ok, Mod, reverse(Data)};
622	{NFD, eof} ->
623	    {missing, NFD, Mod, Data, What};
624	{NFD, {ok, <<IdL:4/binary, Sz:32>>}} ->
625	    Id = binary_to_list(IdL),
626	    Pos1 = Pos + 8,
627	    Pos2 = (4 * trunc((Sz+3) / 4)) + Pos1,
628	    get_data(What, Id, NFD, Sz, Pos1, Pos2, Mod, Data);
629	{_NFD, {ok, _ChunkHead}} ->
630	    error({invalid_beam_file, filename(FD), Pos})
631    end.
632
633get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, Encoding) ->
634    NewCs = del_chunk(Id, Cs),
635    {NFD, Chunk} = get_chunk(Id, Pos, Size, FD),
636    <<_Num:32, Chunk2/binary>> = Chunk,
637    {Module, _} = extract_atom(Chunk2, Encoding),
638    C = case Cs of
639	    info ->
640		{Id, Pos, Size};
641	    _ ->
642		{Id, Chunk}
643	end,
644    scan_beam(NFD, Pos2, NewCs, Module, [C | Data]).
645
646get_data(Cs, "Atom" = Id, FD, Size, Pos, Pos2, _Mod, Data) ->
647    get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, latin1);
648get_data(Cs, "AtU8" = Id, FD, Size, Pos, Pos2, _Mod, Data) ->
649    get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, utf8);
650get_data(info, Id, FD, Size, Pos, Pos2, Mod, Data) ->
651    scan_beam(FD, Pos2, info, Mod, [{Id, Pos, Size} | Data]);
652get_data(Chunks, Id, FD, Size, Pos, Pos2, Mod, Data) ->
653    {NFD, NewData} = case member(Id, Chunks) of
654			 true ->
655			     {FD1, Chunk} = get_chunk(Id, Pos, Size, FD),
656			     {FD1, [{Id, Chunk} | Data]};
657			 false ->
658			     {FD, Data}
659	      end,
660    NewChunks = del_chunk(Id, Chunks),
661    scan_beam(NFD, Pos2, NewChunks, Mod, NewData).
662
663del_chunk(_Id, info) ->
664    info;
665del_chunk(Id, Chunks) ->
666    delete(Id, Chunks).
667
668%% -> {NFD, binary()} | throw(Error)
669get_chunk(Id, Pos, Size, FD) ->
670    case pread(FD, Pos, Size) of
671	{NFD, eof} when Size =:= 0 -> % cannot happen
672	    {NFD, <<>>};
673	{_NFD, eof} when Size > 0 ->
674	    error({chunk_too_big, filename(FD), Id, Size, 0});
675	{_NFD, {ok, Chunk}} when Size > byte_size(Chunk) ->
676	    error({chunk_too_big, filename(FD), Id, Size, byte_size(Chunk)});
677	{NFD, {ok, Chunk}} -> % when Size =:= size(Chunk)
678	    {NFD, Chunk}
679    end.
680
681chunks_to_data([{atom_chunk, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) ->
682    {NewAtoms, Ret} = chunk_to_data(Name, <<"">>, File, Cs, Atoms, Module),
683    chunks_to_data(CNs, Chunks, File, Cs, Module, NewAtoms, [Ret | L]);
684chunks_to_data([{abst_chunk, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) ->
685    DbgiChunk = proplists:get_value("Dbgi", Chunks, <<"">>),
686    {NewAtoms, Ret} =
687	case catch chunk_to_data(debug_info, DbgiChunk, File, Cs, Atoms, Module) of
688	    {DbgiAtoms, {debug_info, {debug_info_v1, Backend, Metadata}}} ->
689		try Backend:debug_info(erlang_v1, Module, Metadata, []) of
690		    {ok, Code} -> {DbgiAtoms, {abstract_code, {raw_abstract_v1, Code}}};
691		    {error, _} -> {DbgiAtoms, {abstract_code, no_abstract_code}}
692                catch
693                    error:undef ->
694                        error({missing_backend,File,Backend})
695                end;
696            {error,beam_lib,{key_missing_or_invalid,Path,debug_info}} ->
697                error({key_missing_or_invalid,Path,abstract_code});
698	    _ ->
699		AbstChunk = proplists:get_value("Abst", Chunks, <<"">>),
700		chunk_to_data(Name, AbstChunk, File, Cs, Atoms, Module)
701	end,
702    chunks_to_data(CNs, Chunks, File, Cs, Module, NewAtoms, [Ret | L]);
703chunks_to_data([{Id, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) ->
704    {_Id, Chunk} = lists:keyfind(Id, 1, Chunks),
705    {NewAtoms, Ret} = chunk_to_data(Name, Chunk, File, Cs, Atoms, Module),
706    chunks_to_data(CNs, Chunks, File, Cs, Module, NewAtoms, [Ret | L]);
707chunks_to_data([], _Chunks, _File, _Cs, Module, _Atoms, L) ->
708    {ok, {Module, reverse(L)}}.
709
710chunk_to_data(attributes=Id, Chunk, File, _Cs, AtomTable, _Mod) ->
711    try
712	Term = binary_to_term(Chunk),
713	{AtomTable, {Id, attributes(Term)}}
714    catch
715	error:badarg ->
716	    error({invalid_chunk, File, chunk_name_to_id(Id, File)})
717    end;
718chunk_to_data(compile_info=Id, Chunk, File, _Cs, AtomTable, _Mod) ->
719    try
720	{AtomTable, {Id, binary_to_term(Chunk)}}
721    catch
722	error:badarg ->
723	    error({invalid_chunk, File, chunk_name_to_id(Id, File)})
724    end;
725chunk_to_data(debug_info=Id, Chunk, File, _Cs, AtomTable, Mod) ->
726    case Chunk of
727	<<>> ->
728	    {AtomTable, {Id, no_debug_info}};
729	<<0:8,N:8,Mode0:N/binary,Rest/binary>> ->
730	    Mode = binary_to_atom(Mode0, utf8),
731	    Term = decrypt_chunk(Mode, Mod, File, Id, Rest),
732	    {AtomTable, {Id, anno_from_term(Term)}};
733	_ ->
734	    case catch binary_to_term(Chunk) of
735		{'EXIT', _} ->
736		    error({invalid_chunk, File, chunk_name_to_id(Id, File)});
737		Term ->
738                    {AtomTable, {Id, anno_from_term(Term)}}
739	    end
740    end;
741chunk_to_data(abstract_code=Id, Chunk, File, _Cs, AtomTable, Mod) ->
742    %% Before Erlang/OTP 20.0.
743    case Chunk of
744	<<>> ->
745	    {AtomTable, {Id, no_abstract_code}};
746	<<0:8,N:8,Mode0:N/binary,Rest/binary>> ->
747	    Mode = binary_to_atom(Mode0, utf8),
748	    Term = decrypt_chunk(Mode, Mod, File, Id, Rest),
749	    {AtomTable, {Id, old_anno_from_term(Term)}};
750	_ ->
751	    case catch binary_to_term(Chunk) of
752		{'EXIT', _} ->
753		    error({invalid_chunk, File, chunk_name_to_id(Id, File)});
754		Term ->
755                    try
756                        {AtomTable, {Id, old_anno_from_term(Term)}}
757                    catch
758                        _:_ ->
759                            error({invalid_chunk, File,
760                                   chunk_name_to_id(Id, File)})
761                    end
762	    end
763    end;
764chunk_to_data(atoms=Id, _Chunk, _File, Cs, AtomTable0, _Mod) ->
765    AtomTable = ensure_atoms(AtomTable0, Cs),
766    Atoms = ets:tab2list(AtomTable),
767    {AtomTable, {Id, lists:sort(Atoms)}};
768chunk_to_data(ChunkName, Chunk, File,
769	      Cs, AtomTable, _Mod) when is_atom(ChunkName) ->
770    case catch symbols(Chunk, AtomTable, Cs, ChunkName) of
771	{ok, NewAtomTable, S} ->
772	    {NewAtomTable, {ChunkName, S}};
773	{'EXIT', _} ->
774	    error({invalid_chunk, File, chunk_name_to_id(ChunkName, File)})
775    end;
776chunk_to_data(ChunkId, Chunk, _File,
777	      _Cs, AtomTable, _Module) when is_list(ChunkId) ->
778    {AtomTable, {ChunkId, Chunk}}. % Chunk is a binary
779
780chunk_name_to_id(indexed_imports, _) -> "ImpT";
781chunk_name_to_id(imports, _)         -> "ImpT";
782chunk_name_to_id(exports, _)         -> "ExpT";
783chunk_name_to_id(labeled_exports, _) -> "ExpT";
784chunk_name_to_id(locals, _)          -> "LocT";
785chunk_name_to_id(labeled_locals, _)  -> "LocT";
786chunk_name_to_id(attributes, _)      -> "Attr";
787chunk_name_to_id(abstract_code, _)   -> "Abst";
788chunk_name_to_id(debug_info, _)      -> "Dbgi";
789chunk_name_to_id(compile_info, _)    -> "CInf";
790chunk_name_to_id(Other, File) ->
791    error({unknown_chunk, File, Other}).
792
793%% Extract attributes
794
795attributes(Attrs) ->
796    attributes(keysort(1, Attrs), []).
797
798attributes([], R) ->
799    reverse(R);
800attributes(L, R) ->
801    K = element(1, hd(L)),
802    {L1, L2} = splitwith(fun(T) -> element(1, T) =:= K end, L),
803    V = append([A || {_, A} <- L1]),
804    attributes(L2, [{K, V} | R]).
805
806%% Extract symbols
807
808symbols(<<_Num:32, B/binary>>, AT0, Cs, Name) ->
809    AT = ensure_atoms(AT0, Cs),
810    symbols1(B, AT, Name, [], 1).
811
812symbols1(<<I1:32, I2:32, I3:32, B/binary>>, AT, Name, S, Cnt) ->
813    Symbol = symbol(Name, AT, I1, I2, I3, Cnt),
814    symbols1(B, AT, Name, [Symbol|S], Cnt+1);
815symbols1(<<>>, AT, _Name, S, _Cnt) ->
816    {ok, AT, sort(S)}.
817
818symbol(indexed_imports, AT, I1, I2, I3, Cnt) ->
819    {Cnt, atm(AT, I1), atm(AT, I2), I3};
820symbol(imports, AT, I1, I2, I3, _Cnt) ->
821    {atm(AT, I1), atm(AT, I2), I3};
822symbol(labeled_exports, AT, I1, I2, I3, _Cnt) ->
823    {atm(AT, I1), I2, I3};
824symbol(labeled_locals, AT, I1, I2, I3, _Cnt) ->
825    {atm(AT, I1), I2, I3};
826symbol(_, AT, I1, I2, _I3, _Cnt) ->
827    {atm(AT, I1), I2}.
828
829atm(AT, N) ->
830    [{_N, S}] = ets:lookup(AT, N),
831    S.
832
833%% AT is updated.
834ensure_atoms({empty, AT}, Cs) ->
835    case lists:keyfind("AtU8", 1, Cs) of
836	{_Id, AtomChunk} when is_binary(AtomChunk) ->
837	    extract_atoms(AtomChunk, AT, utf8);
838	_ ->
839	    {_Id, AtomChunk} = lists:keyfind("Atom", 1, Cs),
840	    extract_atoms(AtomChunk, AT, latin1)
841    end,
842    AT;
843ensure_atoms(AT, _Cs) ->
844    AT.
845
846extract_atoms(<<_Num:32, B/binary>>, AT, Encoding) ->
847    extract_atoms(B, 1, AT, Encoding).
848
849extract_atoms(<<>>, _I, _AT, _Encoding) ->
850    true;
851extract_atoms(B, I, AT, Encoding) ->
852    {Atom, B1} = extract_atom(B, Encoding),
853    true = ets:insert(AT, {I, Atom}),
854    extract_atoms(B1, I+1, AT, Encoding).
855
856extract_atom(<<Len, B/binary>>, Encoding) ->
857    <<SB:Len/binary, Tail/binary>> = B,
858    {binary_to_atom(SB, Encoding), Tail}.
859
860%%% Utils.
861
862-record(bb, {pos = 0 :: integer(),
863	     bin :: binary(),
864	     source :: binary() | string()}).
865
866open_file(<<"FOR1",_/binary>>=Binary) ->
867    #bb{bin = Binary, source = Binary};
868open_file(Binary0) when is_binary(Binary0) ->
869    Binary = uncompress(Binary0),
870    #bb{bin = Binary, source = Binary};
871open_file(FileName) ->
872    case file:open(FileName, [read, raw, binary]) of
873	{ok, Fd} ->
874	    read_all(Fd, FileName, []);
875	Error ->
876	    file_error(FileName, Error)
877    end.
878
879read_all(Fd, FileName, Bins) ->
880    case file:read(Fd, 1 bsl 18) of
881	{ok, Bin} ->
882	    read_all(Fd, FileName, [Bin | Bins]);
883	eof ->
884	    ok = file:close(Fd),
885	    #bb{bin = uncompress(reverse(Bins)), source = FileName};
886	Error ->
887	    ok = file:close(Fd),
888	    file_error(FileName, Error)
889    end.
890
891pread(FD, AtPos, Size) ->
892    #bb{pos = Pos, bin = Binary} = FD,
893    Skip = AtPos-Pos,
894    case Binary of
895	<<_:Skip/binary, B:Size/binary, Bin/binary>> ->
896	    NFD = FD#bb{pos = AtPos+Size, bin = Bin},
897	    {NFD, {ok, B}};
898	<<_:Skip/binary, Bin/binary>> when byte_size(Bin) > 0 ->
899	    NFD = FD#bb{pos = AtPos+byte_size(Bin), bin = <<>>},
900	    {NFD, {ok, Bin}};
901        _ ->
902            {FD, eof}
903    end.
904
905filename(BB) when is_binary(BB#bb.source) ->
906    BB#bb.source;
907filename(BB) ->
908    list_to_atom(BB#bb.source).
909
910beam_filename(Bin) when is_binary(Bin) ->
911    Bin;
912beam_filename(File) ->
913    filename:rootname(File, ".beam") ++ ".beam".
914
915
916uncompress(Binary0) ->
917    {ok, Fd} = ram_file:open(Binary0, [write, binary]),
918    {ok, _} = ram_file:uncompress(Fd),
919    {ok, Binary} = ram_file:get_file(Fd),
920    ok = ram_file:close(Fd),
921    Binary.
922
923compress(Binary0) ->
924    {ok, Fd} = ram_file:open(Binary0, [write, binary]),
925    {ok, _} = ram_file:compress(Fd),
926    {ok, Binary} = ram_file:get_file(Fd),
927    ok = ram_file:close(Fd),
928    Binary.
929
930%% -> ok | throw(Error)
931assert_directory(FileName) ->
932    case filelib:is_dir(FileName) of
933	true ->
934	    ok;
935	false ->
936	    error({not_a_directory, FileName})
937    end.
938
939-spec file_error(file:filename(), {'error',atom()}) -> no_return().
940
941file_error(FileName, {error, Reason}) ->
942    error({file_error, FileName, Reason}).
943
944-spec error(term()) -> no_return().
945
946error(Reason) ->
947    throw({error, ?MODULE, Reason}).
948
949%% The following chunks must be kept when stripping a BEAM file.
950
951significant_chunks() ->
952    ["Line" | md5_chunks()].
953
954%% The following chunks are significant when calculating the MD5
955%% for a module. They are listed in the order that they should be MD5:ed.
956
957md5_chunks() ->
958    ["Atom", "AtU8", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"].
959
960%% The following chunks are mandatory in every Beam file.
961
962mandatory_chunks() ->
963    ["Code", "ExpT", "ImpT", "StrT"].
964
965%%% ====================================================================
966%%% The rest of the file handles encrypted debug info.
967%%%
968%%% Encrypting the debug info is only useful if you want to
969%%% have the debug info available all the time (maybe even in a live
970%%% system), but don't want to risk that anyone else but yourself
971%%% can use it.
972%%% ====================================================================
973
974-record(state, {crypto_key_f :: crypto_fun() | 'undefined'}).
975
976-define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server).
977
978decrypt_chunk(Type, Module, File, Id, Bin) ->
979    try
980	KeyString = get_crypto_key({debug_info, Type, Module, File}),
981	{Type,Key,IVec,_BlockSize} = make_crypto_key(Type, KeyString),
982	ok = start_crypto(),
983	NewBin = crypto:crypto_one_time(des_ede3_cbc, Key, IVec, Bin, false),
984	binary_to_term(NewBin)
985    catch
986	_:_ ->
987	    error({key_missing_or_invalid, File, Id})
988    end.
989
990old_anno_from_term({raw_abstract_v1, Forms}) ->
991    {raw_abstract_v1, anno_from_forms(Forms)};
992old_anno_from_term({Tag, Forms}) when Tag =:= abstract_v1;
993                                      Tag =:= abstract_v2 ->
994    try {Tag, anno_from_forms(Forms)}
995    catch
996        _:_ ->
997            {Tag, Forms}
998    end;
999old_anno_from_term(T) ->
1000    T.
1001
1002anno_from_term({debug_info_v1=Tag1, erl_abstract_code=Tag2, {Forms, Opts}}) ->
1003    try {Tag1, Tag2, {anno_from_forms(Forms), Opts}}
1004    catch
1005        _:_ ->
1006            {Tag1, Tag2, {Forms, Opts}}
1007    end;
1008anno_from_term(T) ->
1009    T.
1010
1011anno_from_forms(Forms0) ->
1012    %% Forms with record field types created before OTP 19.0 are
1013    %% replaced by well-formed record forms holding the type
1014    %% information.
1015    Forms = epp:restore_typed_record_fields(Forms0),
1016    [erl_parse:anno_from_term(Form) || Form <- Forms].
1017
1018start_crypto() ->
1019    case crypto:start() of
1020	{error, {already_started, _}} ->
1021	    ok;
1022	ok ->
1023	    ok
1024    end.
1025
1026get_crypto_key(What) ->
1027    call_crypto_server({get_crypto_key, What}).
1028
1029call_crypto_server(Req) ->
1030    try
1031	gen_server:call(?CRYPTO_KEY_SERVER, Req, infinity)
1032    catch
1033	exit:{noproc,_} ->
1034	    %% Not started.
1035	    call_crypto_server_1(Req);
1036	exit:{normal,_} ->
1037	    %% The process finished just as we called it.
1038	    call_crypto_server_1(Req)
1039    end.
1040
1041call_crypto_server_1(Req) ->
1042    case gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []) of
1043	{ok, _} -> ok;
1044	{error, {already_started, _}} -> ok
1045    end,
1046    erlang:yield(),
1047    call_crypto_server(Req).
1048
1049-spec init([]) -> {'ok', #state{}}.
1050
1051init([]) ->
1052    {ok, #state{}}.
1053
1054-type calls() :: 'clear_crypto_key_fun'
1055               | {'crypto_key_fun', _}
1056               | {'get_crypto_key', _}.
1057
1058-spec handle_call(calls(), {pid(), term()}, #state{}) ->
1059        {'noreply', #state{}} |
1060	{'reply', 'error' | {'error','badfun' | 'exists'}, #state{}} |
1061	{'stop', 'normal', 'undefined' | {'ok', term()}, #state{}}.
1062
1063handle_call({get_crypto_key, _}=R, From, #state{crypto_key_f=undefined}=S) ->
1064    case crypto_key_fun_from_file() of
1065	error ->
1066	    {reply, error, S};
1067	F when is_function(F) ->
1068	    %% The init function for the fun has already been called.
1069	    handle_call(R, From, S#state{crypto_key_f=F})
1070    end;
1071handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) ->
1072    try
1073	Result = F(What),
1074	%% The result may hold information that we don't want
1075	%% lying around. Reply first, then GC, then noreply.
1076	gen_server:reply(From, Result),
1077	erlang:garbage_collect(),
1078	{noreply, S}
1079    catch
1080	_:_ ->
1081	    {reply, error, S}
1082    end;
1083handle_call({crypto_key_fun, F}, {_,_} = From, S) ->
1084    case S#state.crypto_key_f of
1085	undefined ->
1086	    if is_function(F, 1) ->
1087		    {Result, Fun, Reply} =
1088			case catch F(init) of
1089			    ok ->
1090				{true, F, ok};
1091			    {ok, F1} when is_function(F1) ->
1092				if
1093				    is_function(F1, 1) ->
1094					{true, F1, ok};
1095				    true ->
1096					{false, undefined,
1097					 {error, badfun}}
1098				end;
1099			    {error, Reason} ->
1100				{false, undefined, {error, Reason}};
1101			    {'EXIT', Reason} ->
1102				{false, undefined, {error, Reason}}
1103			end,
1104		    gen_server:reply(From, Reply),
1105		    erlang:garbage_collect(),
1106		    NewS = case Result of
1107			       true ->
1108				   S#state{crypto_key_f = Fun};
1109			       false ->
1110				   S
1111			   end,
1112		    {noreply, NewS};
1113	       true ->
1114		    {reply, {error, badfun}, S}
1115	    end;
1116	OtherF when is_function(OtherF) ->
1117	    {reply, {error, exists}, S}
1118    end;
1119handle_call(clear_crypto_key_fun, _From, S) ->
1120    case S#state.crypto_key_f of
1121	undefined ->
1122	    {stop,normal,undefined,S};
1123	F ->
1124	    Result = (catch F(clear)),
1125	    {stop,normal,{ok,Result},S}
1126    end.
1127
1128-spec handle_cast(term(), #state{}) -> {'noreply', #state{}}.
1129
1130handle_cast(_, State) ->
1131    {noreply, State}.
1132
1133-spec handle_info(term(), #state{}) -> {'noreply', #state{}}.
1134
1135handle_info(_, State) ->
1136    {noreply, State}.
1137
1138-spec code_change(term(), #state{}, term()) -> {'ok', #state{}}.
1139
1140code_change(_OldVsn, State, _Extra) ->
1141    {ok, State}.
1142
1143-spec terminate(term(), #state{}) -> 'ok'.
1144
1145terminate(_Reason, _State) ->
1146    ok.
1147
1148crypto_key_fun_from_file() ->
1149    case init:get_argument(home) of
1150	{ok,[[Home]]} ->
1151	    crypto_key_fun_from_file_1([".",Home]);
1152	_ ->
1153	    crypto_key_fun_from_file_1(["."])
1154    end.
1155
1156crypto_key_fun_from_file_1(Path) ->
1157    case f_p_s(Path, ".erlang.crypt") of
1158	{ok, KeyInfo, _} ->
1159	    try_load_crypto_fun(KeyInfo);
1160	_ ->
1161	    error
1162    end.
1163
1164f_p_s(P, F) ->
1165    case file:path_script(P, F) of
1166	{error, enoent} ->
1167	    {error, enoent};
1168	{error, {Line, _Mod, _Term}=E} ->
1169	    error("file:path_script(~tp,~tp): error on line ~p: ~ts~n",
1170		  [P, F, Line, file:format_error(E)]),
1171	    ok;
1172	{error, E} when is_atom(E) ->
1173	    error("file:path_script(~tp,~tp): ~ts~n",
1174		  [P, F, file:format_error(E)]),
1175	    ok;
1176	Other ->
1177	    Other
1178    end.
1179
1180try_load_crypto_fun(KeyInfo) when is_list(KeyInfo) ->
1181    T = ets:new(keys, [private, set]),
1182    foreach(
1183      fun({debug_info, Mode, M, Key}) when is_atom(M) ->
1184	      ets:insert(T, {{debug_info,Mode,M,[]}, Key});
1185	 ({debug_info, Mode, [], Key}) ->
1186	      ets:insert(T, {{debug_info, Mode, [], []}, Key});
1187	 (Other) ->
1188	      error("unknown key: ~p~n", [Other])
1189      end, KeyInfo),
1190    fun({debug_info, Mode, M, F}) ->
1191	    alt_lookup_key(
1192	      [{debug_info,Mode,M,F},
1193	       {debug_info,Mode,M,[]},
1194	       {debug_info,Mode,[],[]}], T);
1195       (clear) ->
1196	    ets:delete(T);
1197       (_) ->
1198	    error
1199    end;
1200try_load_crypto_fun(KeyInfo) ->
1201    error("unrecognized crypto key info: ~p\n", [KeyInfo]).
1202
1203alt_lookup_key([H|T], Tab) ->
1204    case ets:lookup(Tab, H) of
1205	[] ->
1206	    alt_lookup_key(T, Tab);
1207	[{_, Val}] ->
1208	    Val
1209    end;
1210alt_lookup_key([], _) ->
1211    error.
1212
1213error(Fmt, Args) ->
1214    error_logger:error_msg(Fmt, Args),
1215    error.
1216