← Back to branch summary

~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/stdlib/src/beam_lib.erl

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/stdlib/src/beam_lib.erl
16
16
%%     $Id $
17
17
%%
18
18
-module(beam_lib).
 
19
-behaviour(gen_server).
19
20
 
20
21
-export([info/1,
21
22
         cmp/2,
30
31
         version/1,
31
32
         format_error/1]).
32
33
 
 
34
%% The following functions implement encrypted debug info.
 
35
 
 
36
-export([crypto_key_fun/1, clear_crypto_key_fun/0]).
 
37
-export([init/1,handle_call/3,handle_cast/2,handle_info/2,
 
38
         terminate/2,code_change/3]).
 
39
-export([make_crypto_key/2, get_crypto_key/1]). %Utilities used by compiler
 
40
 
33
41
-import(lists,
34
42
        [append/1, delete/2, foreach/2, keydelete/3, keymember/3, keysearch/3,
35
43
         keysort/2, map/2, member/2, nthtail/2, prefix/2, reverse/1, 
36
44
         sort/1, splitwith/2]).
37
45
 
38
46
-include_lib("kernel/include/file.hrl").
 
47
-include("erl_compile.hrl").
39
48
 
40
49
%%
41
50
%%  Exported functions
77
86
            Error
78
87
    end.
79
88
 
 
89
format_error({error, Error}) ->
 
90
    format_error(Error);
80
91
format_error({error, Module, Error}) ->
81
92
    Module:format_error(Error);
82
93
format_error({unknown_chunk, File, ChunkName}) ->
104
115
                  [Module1, Module2]);
105
116
format_error({not_a_directory, Name}) ->
106
117
    io_lib:format("~p: Not a directory~n", [Name]);
 
118
format_error({key_missing_or_invalid, File, abstract_code}) ->
 
119
    io_lib:format("~p: Cannot decrypt abstract code because key is missing or invalid",
 
120
                  [File]);
 
121
format_error(badfun) ->
 
122
    "not a fun or the fun has the wrong arity";
 
123
format_error(exists) ->
 
124
    "a fun has already been installed";
107
125
format_error(E) ->
108
126
    io_lib:format("~p~n", [E]).
109
127
 
 
128
%% 
 
129
%% Exported functions for encrypted debug info.
 
130
%%
 
131
 
 
132
crypto_key_fun(F) ->
 
133
    call_crypto_server({crypto_key_fun, F}).
 
134
 
 
135
clear_crypto_key_fun() ->
 
136
    call_crypto_server(clear_crypto_key_fun).
 
137
 
 
138
make_crypto_key(des3_cbc, String) ->
 
139
    <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String),
 
140
    <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|reverse(String)]),
 
141
    {K1,K2,K3,IVec}.
 
142
 
110
143
%%
111
144
%%  Local functions
112
145
%%
301
334
    {ok, Mod, Data};    
302
335
scan_beam(FD, Pos, What, Mod, Data) ->
303
336
    case pread(FD, Pos, 8) of
304
 
        {_NFD, eof} when Mod == 17 ->
 
337
        {_NFD, eof} when Mod =:= 17 ->
305
338
            error({missing_chunk, filename(FD), "Atom"});           
306
 
        {_NFD, eof} when What == info ->
 
339
        {_NFD, eof} when What =:= info ->
307
340
            {ok, Mod, reverse(Data)};
308
341
        {_NFD, eof} ->
309
342
            error({missing_chunk, filename(FD), hd(What)});
316
349
            error({invalid_beam_file, filename(FD), Pos})
317
350
    end.
318
351
 
319
 
get_data(Cs, Id, FD, Size, Pos, Pos2, _Mod, Data) when Id == "Atom" ->
 
352
get_data(Cs, Id, FD, Size, Pos, Pos2, _Mod, Data) when Id =:= "Atom" ->
320
353
    NewCs = del_chunk(Id, Cs),
321
354
    {NFD, Chunk} = get_chunk(Id, Pos, Size, FD),
322
355
    <<_Num:32, Chunk2/binary>> = Chunk,
349
382
%% -> {NFD, binary()} | throw(Error)
350
383
get_chunk(Id, Pos, Size, FD) ->
351
384
    case pread(FD, Pos, Size) of
352
 
        {NFD, eof} when Size == 0 -> % cannot happen
 
385
        {NFD, eof} when Size =:= 0 -> % cannot happen
353
386
            {NFD, <<>>};
354
387
        {_NFD, eof} when Size > 0 ->
355
388
            error({chunk_too_big, filename(FD), Id, Size, 0});
356
389
        {_NFD, {ok, Chunk}} when Size > size(Chunk) ->
357
390
            error({chunk_too_big, filename(FD), Id, Size, size(Chunk)});
358
 
        {NFD, {ok, Chunk}} -> % when Size == size(Chunk)
 
391
        {NFD, {ok, Chunk}} -> % when Size =:= size(Chunk)
359
392
            {NFD, Chunk}
360
393
    end.
361
394
 
362
395
chunks_to_data([{Id, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) ->
363
396
    {value, {_Id, Chunk}} =  keysearch(Id, 1, Chunks),
364
 
    {NewAtoms, Ret} = chunk_to_data(Name, Chunk, File, Cs, Atoms),
 
397
    {NewAtoms, Ret} = chunk_to_data(Name, Chunk, File, Cs, Atoms, Module),
365
398
    chunks_to_data(CNs, Chunks, File, Cs, Module, NewAtoms, [Ret | L]);
366
399
chunks_to_data([], _Chunks, _File, _Cs, Module, _Atoms, L) ->
367
400
    {ok, {Module, reverse(L)}}.
368
401
 
369
 
chunk_to_data(Id, Chunk, File, _Cs, AtomTable) when Id == attributes ->
370
 
    case catch binary_to_term(Chunk) of
371
 
        {'EXIT', _} ->
372
 
            error({invalid_chunk, File, chunk_name_to_id(Id, File)});
373
 
        Term ->
374
 
            {AtomTable, {Id, attributes(Term)}}
375
 
    end;
376
 
chunk_to_data(Id, Chunk, File, _Cs, AtomTable) when Id == abstract_code ->
377
 
    case catch binary_to_term(Chunk) of
378
 
        {'EXIT', _} when <<>> == Chunk ->
 
402
chunk_to_data(Id, Chunk, File, _Cs, AtomTable, _Mod) when Id =:= attributes ->
 
403
    try
 
404
        Term = binary_to_term(Chunk),
 
405
        {AtomTable, {Id, attributes(Term)}}
 
406
    catch
 
407
        error:badarg ->
 
408
            error({invalid_chunk, File, chunk_name_to_id(Id, File)})
 
409
    end;
 
410
chunk_to_data(Id, Chunk, File, _Cs, AtomTable, _Mod) when Id =:= compile_info ->
 
411
    try
 
412
        {AtomTable, {Id, binary_to_term(Chunk)}}
 
413
    catch
 
414
        error:badarg ->
 
415
            error({invalid_chunk, File, chunk_name_to_id(Id, File)})
 
416
    end;
 
417
chunk_to_data(Id, Chunk, File, _Cs, AtomTable, Mod) when Id =:= abstract_code ->
 
418
    case Chunk of
 
419
        <<>> ->
379
420
            {AtomTable, {Id, no_abstract_code}};
380
 
        {'EXIT', _} ->
381
 
            error({invalid_chunk, File, chunk_name_to_id(Id, File)});
382
 
        Term ->
383
 
            {AtomTable, {Id, Term}}
 
421
        <<0:8,N:8,Mode0:N/binary,Rest/binary>> ->
 
422
            Mode = list_to_atom(binary_to_list(Mode0)),
 
423
            decrypt_abst(Mode, Mod, File, Id, AtomTable, Rest);
 
424
        _ ->
 
425
            case catch binary_to_term(Chunk) of
 
426
                {'EXIT', _} ->
 
427
                    error({invalid_chunk, File, chunk_name_to_id(Id, File)});
 
428
                Term ->
 
429
                    {AtomTable, {Id, Term}}
 
430
            end
384
431
    end;
385
 
chunk_to_data(Id, _Chunk, _File, Cs, AtomTable0) when Id == atoms ->
 
432
chunk_to_data(Id, _Chunk, _File, Cs, AtomTable0, _Mod) when Id =:= atoms ->
386
433
    AtomTable = ensure_atoms(AtomTable0, Cs),
387
434
    Atoms = ets:tab2list(AtomTable),
388
435
    {AtomTable, {Id, lists:sort(Atoms)}};
389
 
chunk_to_data(ChunkName, Chunk, File, Cs, AtomTable) when atom(ChunkName) ->
 
436
chunk_to_data(ChunkName, Chunk, File,
 
437
              Cs, AtomTable, _Mod) when atom(ChunkName) ->
390
438
    case catch symbols(Chunk, AtomTable, Cs, ChunkName) of
391
439
        {ok, NewAtomTable, S} ->
392
440
            {NewAtomTable, {ChunkName, S}};
393
441
        {'EXIT', _} ->
394
442
            error({invalid_chunk, File, chunk_name_to_id(ChunkName, File)})
395
443
    end;
396
 
chunk_to_data(ChunkId, Chunk, _File, _Cs, AtomTable) -> % when list(ChunkId)
 
444
chunk_to_data(ChunkId, Chunk, _File, 
 
445
              _Cs, AtomTable, _Module) -> % when list(ChunkId)
397
446
    {AtomTable, {ChunkId, Chunk}}. % Chunk is a binary
398
447
 
399
448
chunk_name_to_id(atoms, _)           -> "Atom";
 
449
chunk_name_to_id(indexed_imports, _) -> "ImpT";
400
450
chunk_name_to_id(imports, _)         -> "ImpT";
401
451
chunk_name_to_id(exports, _)         -> "ExpT";
402
452
chunk_name_to_id(labeled_exports, _) -> "ExpT";
404
454
chunk_name_to_id(labeled_locals, _)  -> "LocT";
405
455
chunk_name_to_id(attributes, _)      -> "Attr";
406
456
chunk_name_to_id(abstract_code, _)   -> "Abst";
 
457
chunk_name_to_id(compile_info, _)    -> "CInf";
407
458
chunk_name_to_id(Other, File) -> 
408
459
    error({unknown_chunk, File, Other}).
409
460
 
416
467
    reverse(R);
417
468
attributes(L, R) ->
418
469
    K = element(1, hd(L)),
419
 
    {L1, L2} = splitwith(fun(T) -> element(1, T) == K end, L),
 
470
    {L1, L2} = splitwith(fun(T) -> element(1, T) =:= K end, L),
420
471
    V = append([A || {_, A} <- L1]),
421
472
    attributes(L2, [{K, V} | R]).
422
473
 
424
475
 
425
476
symbols(<<_Num:32, B/binary>>, AT0, Cs, Name) ->
426
477
    AT = ensure_atoms(AT0, Cs),
427
 
    symbols1(B, AT, Name, []).
 
478
    symbols1(B, AT, Name, [], 1).
428
479
 
429
 
symbols1(<<I1:32, I2:32, I3:32, B/binary>>, AT, Name, S) ->
430
 
    Symbol = symbol(Name, AT, I1, I2, I3),
431
 
    symbols1(B, AT, Name, [Symbol|S]);
432
 
symbols1(<<>>, AT, _Name, S) ->
 
480
symbols1(<<I1:32, I2:32, I3:32, B/binary>>, AT, Name, S, Cnt) ->
 
481
    Symbol = symbol(Name, AT, I1, I2, I3, Cnt),
 
482
    symbols1(B, AT, Name, [Symbol|S], Cnt+1);
 
483
symbols1(<<>>, AT, _Name, S, _Cnt) ->
433
484
    {ok, AT, sort(S)}.
434
485
 
435
 
symbol(imports, AT, I1, I2, I3) ->
 
486
symbol(indexed_imports, AT, I1, I2, I3, Cnt) ->
 
487
    {Cnt, atm(AT, I1), atm(AT, I2), I3};
 
488
symbol(imports, AT, I1, I2, I3, _Cnt) ->
436
489
    {atm(AT, I1), atm(AT, I2), I3};
437
 
symbol(Name, AT, I1, I2, I3) when Name == labeled_exports; 
438
 
                                  Name == labeled_locals ->
 
490
symbol(Name, AT, I1, I2, I3, _Cnt) when Name =:= labeled_exports; 
 
491
                                        Name =:= labeled_locals ->
439
492
    {atm(AT, I1), I2, I3};
440
 
symbol(_, AT, I1, I2, _I3) ->
 
493
symbol(_, AT, I1, I2, _I3, _Cnt) ->
441
494
    {atm(AT, I1), I2}.
442
495
 
443
496
atm(AT, N) ->
519
572
beam_filename(File) ->
520
573
    filename:rootname(File, ".beam") ++ ".beam".
521
574
 
 
575
 
522
576
uncompress(Binary0) ->
523
577
    {ok, Fd} = ram_file:open(Binary0, [write, binary]),
524
578
    {ok, _} = ram_file:uncompress(Fd),
547
601
 
548
602
error(Reason) ->
549
603
    throw({error, ?MODULE, Reason}).
 
604
 
 
605
%%% ====================================================================
 
606
%%% The rest of the file handles encrypted debug info.
 
607
%%%
 
608
%%% Encrypting the debug info is only useful if you want to
 
609
%%% have the debug info available all the time (maybe even in a live
 
610
%%% system), but don't want to risk that anyone else but yourself
 
611
%%% can use it.
 
612
%%% ====================================================================
 
613
 
 
614
-record(state, {crypto_key_f}).
 
615
-define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server).
 
616
 
 
617
decrypt_abst(Mode, Module, File, Id, AtomTable, Bin) ->
 
618
    try
 
619
        KeyString = get_crypto_key({debug_info, Mode, Module, File}),
 
620
        Key = make_crypto_key(des3_cbc, KeyString),
 
621
        Term = decrypt_abst_1(Mode, Key, Bin),
 
622
        {AtomTable, {Id, Term}}
 
623
    catch
 
624
        _:_ ->
 
625
            error({key_missing_or_invalid, File, Id})
 
626
    end.
 
627
 
 
628
decrypt_abst_1(des3_cbc, {K1, K2, K3, IVec}, Bin) ->
 
629
    ok = start_crypto(),
 
630
    NewBin = crypto:des3_cbc_decrypt(K1, K2, K3, IVec, Bin),
 
631
    binary_to_term(NewBin).
 
632
 
 
633
start_crypto() ->
 
634
    case crypto:start() of
 
635
        {error, {already_started, _}} ->
 
636
            ok;
 
637
        ok ->
 
638
            ok
 
639
    end.
 
640
 
 
641
get_crypto_key(What) ->
 
642
    call_crypto_server({get_crypto_key, What}).
 
643
 
 
644
call_crypto_server(Req) ->
 
645
    try 
 
646
        gen_server:call(?CRYPTO_KEY_SERVER, Req, infinity)
 
647
    catch
 
648
        exit:{noproc,_} ->
 
649
            start_crypto_server(),
 
650
            erlang:yield(),
 
651
            call_crypto_server(Req)
 
652
    end.
 
653
 
 
654
start_crypto_server() ->
 
655
    gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []).
 
656
 
 
657
init([]) ->
 
658
    {ok,#state{}}.
 
659
 
 
660
handle_call({get_crypto_key, _}=R, From, #state{crypto_key_f=undefined}=S) ->
 
661
    case crypto_key_fun_from_file() of
 
662
        error ->
 
663
            {reply, error, S};
 
664
        F when is_function(F) ->
 
665
            %% The init function for the fun has already been called.
 
666
            handle_call(R, From, S#state{crypto_key_f=F})
 
667
    end;
 
668
handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) ->
 
669
    try
 
670
        Result = F(What),
 
671
        %% The result may hold information that we don't want 
 
672
        %% lying around. Reply first, then GC, then noreply.
 
673
        gen_server:reply(From, Result),
 
674
        erlang:garbage_collect(),
 
675
        {noreply, S}
 
676
    catch
 
677
        _:_ ->
 
678
            {reply, error, S}
 
679
    end;
 
680
handle_call({crypto_key_fun, F}, {_,_} = From, S) ->
 
681
    case S#state.crypto_key_f of
 
682
        undefined ->
 
683
            %% Don't allow tuple funs here. (They weren't allowed before,
 
684
            %% so there is no reason to allow them now.)
 
685
            if is_function(F), is_function(F, 1) ->
 
686
                    {Result, Fun, Reply} = 
 
687
                        case catch F(init) of
 
688
                            ok ->
 
689
                                {true, F, ok};
 
690
                            {ok, F1} when is_function(F1) ->
 
691
                                if
 
692
                                    is_function(F1, 1) ->
 
693
                                        {true, F1, ok};
 
694
                                    true ->
 
695
                                        {false, undefined, 
 
696
                                         {error, badfun}}
 
697
                                end;
 
698
                            {error, Reason} ->
 
699
                                {false, undefined, {error, Reason}};
 
700
                            {'EXIT', Reason} ->
 
701
                                {false, undefined, {error, Reason}}
 
702
                        end,
 
703
                    gen_server:reply(From, Reply),
 
704
                    erlang:garbage_collect(),
 
705
                    NewS = case Result of
 
706
                               true ->
 
707
                                   S#state{crypto_key_f = Fun};
 
708
                               false ->
 
709
                                   S
 
710
                           end,
 
711
                    {noreply, NewS};
 
712
               true ->
 
713
                    {reply, {error, badfun}, S}
 
714
            end;
 
715
        OtherF when is_function(OtherF) ->
 
716
            {reply, {error, exists}, S}
 
717
    end;
 
718
handle_call(clear_crypto_key_fun, _From, S) ->
 
719
    case S#state.crypto_key_f of
 
720
        undefined ->
 
721
            {stop,normal,undefined,S};
 
722
        F ->
 
723
            Result = (catch F(clear)),
 
724
            {stop,normal,{ok,Result},S}
 
725
    end.
 
726
 
 
727
handle_cast(_, State) ->
 
728
    {noreply, State}.
 
729
 
 
730
handle_info(_, State) ->
 
731
    {noreply, State}.
 
732
 
 
733
code_change(_OldVsn, State, _Extra) ->
 
734
    {ok, State}.
 
735
    
 
736
terminate(_Reason, _State) ->
 
737
    ok.
 
738
 
 
739
crypto_key_fun_from_file() ->
 
740
    case init:get_argument(home) of
 
741
        {ok,[[Home]]} ->
 
742
            crypto_key_fun_from_file_1([".",Home]);
 
743
        _ ->
 
744
            crypto_key_fun_from_file_1(["."])
 
745
    end.
 
746
 
 
747
crypto_key_fun_from_file_1(Path) ->
 
748
    case f_p_s(Path, ".erlang.crypt") of
 
749
        {ok, KeyInfo, _} ->
 
750
            try_load_crypto_fun(KeyInfo);
 
751
        _ ->
 
752
            error
 
753
    end.
 
754
 
 
755
f_p_s(P, F) ->
 
756
    case file:path_script(P, F) of
 
757
        {error, enoent} ->
 
758
            {error, enoent};
 
759
        {error, {Line, _Mod, _Term}=E} ->
 
760
            error("file:path_script(~p,~p): error on line ~p: ~s~n",
 
761
                  [P, F, Line, file:format_error(E)]),
 
762
            ok;
 
763
        {error, E} when is_atom(E) ->
 
764
            error("file:path_script(~p,~p): ~s~n",
 
765
                  [P, F, file:format_error(E)]),
 
766
            ok;
 
767
        Other ->
 
768
            Other
 
769
    end.
 
770
 
 
771
try_load_crypto_fun(KeyInfo) when is_list(KeyInfo) ->
 
772
    T = ets:new(keys, [private, set]),
 
773
    foreach(
 
774
      fun({debug_info, Mode, M, Key}) when is_atom(M) ->
 
775
              ets:insert(T, {{debug_info,Mode,M,[]}, Key});
 
776
         ({debug_info, Mode, [], Key}) ->
 
777
              ets:insert(T, {{debug_info, Mode, [], []}, Key});
 
778
         (Other) ->
 
779
              error("unknown key: ~p~n", [Other])
 
780
      end, KeyInfo),
 
781
    fun({debug_info, Mode, M, F}) ->
 
782
            alt_lookup_key(
 
783
              [{debug_info,Mode,M,F},
 
784
               {debug_info,Mode,M,[]},
 
785
               {debug_info,Mode,[],[]}], T);
 
786
       (clear) ->
 
787
            ets:delete(T);
 
788
       (_) ->
 
789
            error
 
790
    end;
 
791
try_load_crypto_fun(KeyInfo) ->
 
792
    error("unrecognized crypto key info: ~p\n", [KeyInfo]).
 
793
 
 
794
alt_lookup_key([H|T], Tab) ->
 
795
    case ets:lookup(Tab, H) of
 
796
        [] ->
 
797
            alt_lookup_key(T, Tab);
 
798
        [{_, Val}] ->
 
799
            Val
 
800
    end;
 
801
alt_lookup_key([], _) ->
 
802
    error.
 
803
 
 
804
error(Fmt, Args) ->
 
805
    error_logger:error_msg(Fmt, Args),
 
806
    error.