PageRenderTime 131ms CodeModel.GetById 3ms app.highlight 117ms RepoModel.GetById 1ms app.codeStats 0ms

/lib/stdlib/src/beam_lib.erl

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