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