lib/stdlib/src/Makefile | 2 + lib/stdlib/src/beam_lib.erl | 300 ++++++++++++++++++++++++++++++++++++++---- lib/stdlib/src/beam_strip.erl | 193 +++++++++++++++++++++++++++ lib/stdlib/src/getopt.erl | 90 +++++++++++++ lib/stdlib/src/stdlib.app.src | 2 +- 5 files changed, 561 insertions(+), 26 deletions(-) diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 1430482..a123296 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -43,6 +43,7 @@ MODULES= \ array \ base64 \ beam_lib \ + beam_strip \ binary \ c \ calendar \ @@ -83,6 +84,7 @@ MODULES= \ gen_event \ gen_fsm \ gen_server \ + getopt \ io \ io_lib \ io_lib_format \ diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index e9a5e68..415fbac 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -29,9 +29,18 @@ chunks/2, chunks/3, all_chunks/1, + hipe_chunk/0, + hipe_chunks/0, + hipe_chunks/1, + significant_chunks/0, + mandatory_chunks/0, diff_dirs/2, strip/1, + strip/2, + strip/3, strip_files/1, + strip_files/2, + strip_files/3, strip_release/1, build_module/1, version/1, @@ -48,7 +57,7 @@ -export_type([attrib_entry/0, compinfo_entry/0, labeled_entry/0]). -import(lists, [append/1, delete/2, foreach/2, keysort/2, - member/2, reverse/1, sort/1, splitwith/2]). + member/2, reverse/1, sort/1, splitwith/2, foldl/3, foldr/3]). %%------------------------------------------------------------------------- @@ -157,6 +166,27 @@ cmp(File1, File2) -> try cmp_files(File1, File2) catch Error -> Error end. +hipe_chunk() -> + try hipe_unified_loader:chunk_name(erlang:system_info(hipe_architecture)) + catch _ -> "" end. + +hipe_chunks() -> + try [hipe_chunk()] + catch _ -> [] end. + +hipe_chunks(File) -> + try foldr( + fun(E, L) -> + case E of + [$H|_] -> [E|L]; + _ -> L + end + end, + [], + all_chunks_list(File)) + catch _ -> [] end. + + -spec cmp_dirs(Dir1, Dir2) -> {Only1, Only2, Different} | {'error', 'beam_lib', Reason} when Dir1 :: atom() | file:filename(), @@ -185,6 +215,18 @@ diff_dirs(Dir1, Dir2) -> strip(FileName) -> try strip_file(FileName) catch Error -> Error end. + +strip(FileName, C) when is_atom(C) -> + try strip_file(FileName, C) + catch Error -> Error end; + +strip(FileName, Chunks) -> + try strip_file(FileName, Chunks) + catch Error -> Error end. + +strip(FileName, Chunks, C) when is_atom(C) -> + try strip_file(FileName, Chunks, C) + catch Error -> Error end. -spec strip_files(Files) -> {'ok', [{module(), Beam}]} | {'error', 'beam_lib', info_rsn()} when @@ -195,7 +237,20 @@ strip_files(Files) when is_list(Files) -> try strip_fils(Files) catch Error -> Error end. --spec strip_release(Dir) -> +strip_files(Files, C) when is_atom(C) -> + try strip_fils(Files, C) + catch Error -> Error end; + +strip_files(Files, Chunks) -> + try strip_fils(Files, Chunks) + catch Error -> Error end. + +strip_files(Files, Chunks, C) when is_atom(C) -> + try strip_fils(Files, Chunks, C) + catch Error -> Error end. + + +-spec strip_release( Dir | file:filename()) -> {'ok', [{module(), file:filename()}]} | {'error', 'beam_lib', Reason} when Dir :: atom() | file:filename(), @@ -390,34 +445,115 @@ strip_rel(Root) -> strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam"))). %% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) +strip_fils({Files, Dir}, C) when is_atom(C) -> + {ok, [begin {ok, Reply} = strip_file({F, Dir}, C), Reply end || F <- Files]}; + +%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) +strip_fils(Files, C) when is_atom(C) -> + {ok, [begin {ok, Reply} = strip_file(F, C), Reply end || F <- Files]}; + +%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) +strip_fils({Files, Dir}, Chunks) -> + {ok, [begin {ok, Reply} = strip_file({F, Dir}, Chunks), Reply end || F <- Files]}; + +%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) +strip_fils(Files, Chunks) -> + {ok, [begin {ok, Reply} = strip_file(F, Chunks), Reply end || F <- Files]}. + +%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) +strip_fils({Files, Dir}, Chunks, C) when is_atom(C)-> + {ok, [begin {ok, Reply} = strip_file({F, Dir}, Chunks, C), Reply end || F <- Files]}; + +%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) +strip_fils(Files, Chunks, C) when is_atom(C)-> + {ok, [begin {ok, Reply} = strip_file(F, Chunks, C), Reply end || F <- Files]}. + +%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) strip_fils(Files) -> - {ok, [begin {ok, Reply} = strip_file(F), Reply end || F <- Files]}. + strip_fils(Files, compress). + +%% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) +strip_file(File, ChunkList, C) when is_atom(C) -> + {ok, {Mod, Chunks}} = read_chunks(file0(File), ChunkList), + strip_file_output(File, Mod, Chunks, C). + +%% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) +strip_file(File, C) when is_atom(C) -> + {ok, {Mod, Chunks}} = read_unstripped_chunks(file0(File)), + strip_file_output(File, Mod, Chunks, C); + +%% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) +strip_file(File, ChunkList) -> + {ok, {Mod, Chunks}} = read_chunks(file0(File), ChunkList), + strip_file_output(File, Mod, Chunks). %% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) strip_file(File) -> - {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()), - {ok, Stripped0} = build_module(Chunks), - Stripped = compress(Stripped0), - case File of - _ when is_binary(File) -> - {ok, {Mod, Stripped}}; - _ -> - FileName = beam_filename(File), - case file:open(FileName, [raw, binary, write]) of - {ok, Fd} -> - case file:write(Fd, Stripped) of - ok -> - ok = file:close(Fd), - {ok, {Mod, FileName}}; - Error -> - ok = file:close(Fd), - file_error(FileName, Error) - end; + strip_file(File, compress). + +dir_file(Dir, File) when is_atom(Dir) -> + dir_file(atom_to_list(Dir), File); + +dir_file(Dir, File) when is_integer(Dir) -> + dir_file(integer_to_list(Dir), File); + +dir_file(Dir, File) when is_float(Dir) -> + dir_file(float_to_list(Dir), File); + +dir_file(Dir, File) when is_atom(File) -> + dir_file(Dir, atom_to_list(File)); + +dir_file(Dir, File) when is_integer(File) -> + dir_file(Dir, integer_to_list(File)); + +dir_file(Dir, File) when is_float(File) -> + dir_file(Dir, float_to_list(File)); + +dir_file(Dir, File) -> + filename:join(Dir, filename:basename(File)). + +strip_file_output0({File, Dir}, Mod, Data) -> + strip_file_output0(dir_file(Dir, File), Mod, Data); + +strip_file_output0(File, Mod, Data) -> + FileName = beam_filename(File), + case file:open(FileName, [raw, binary, write]) of + {ok, Fd} -> + case file:write(Fd, Data) of + ok -> + ok = file:close(Fd), + {ok, {Mod, FileName}}; Error -> + ok = file:close(Fd), file_error(FileName, Error) - end + end; + Error -> + file_error(FileName, Error) end. +strip_file_output(File, Mod, Data) when is_binary(File) -> + strip_file_output(File, Mod, Data, nocompress). + +strip_file_output(File, Mod, Data, nocompress) when is_binary(File) -> + {ok, {Mod, Data}}; + +strip_file_output(File, Mod, Data, compress) when is_binary(File) -> + {ok, {Mod, compress(Data)}}; + +strip_file_output(File, Mod, Chunks, nocompress) -> + {ok, Data} = build_module(Chunks), + strip_file_output0(File, Mod, Data); + +strip_file_output(File, Mod, Chunks, compress) -> + {ok, Data} = build_module(Chunks), + strip_file_output0(File, Mod, compress(Data)). + +file0({File, _}) -> + file0(File); + +file0(File) -> + beam_filename(File). + build_module(Chunks0) -> Chunks = list_to_binary(build_chunks(Chunks0)), Size = byte_size(Chunks), @@ -438,6 +574,104 @@ pad(Size) -> Rem -> lists:duplicate(4 - Rem, 0) end. +read_chunks_info(File) when is_atom(File) -> + read_chunks_info(beam_filename(File)); + +read_chunks_info(File) -> + try + {ok, _, Data} = scan_beam(File, info), + {ok, Data} + catch Error -> Error end. + +empty_chunks(File) when is_atom(File) -> + empty_chunks(beam_filename(File)); + +empty_chunks(File) -> + case read_chunks_info(File) of + {ok, List} -> + MC = mandatory_chunks(), + foldr( + fun(T, L) -> + case T of + {E, _, 0} -> + case lists:member(E, MC) of + true -> L; + _ -> [E|L] + end; + _ -> L + end + end, + [], + List); + {error, beam_lib, _} -> + []; + _ -> + [] + end. + +all_chunks_list(File, Opt) when is_atom(File) -> + all_chunks_list(beam_filename(File), Opt); + +all_chunks_list(File, Opt) -> + case read_chunks_info(File) of + {ok, List} -> + foldr( + fun(T, L) -> + case T of + {_, _, 0} when Opt =:= nonempty -> L; + _ -> [element(1, T)|L] + end + end, + [], + List); + {error, beam_lib, _} -> + []; + _ -> + [] + end. + +all_chunks_list(File) -> all_chunks_list(File, all). + +chunk_id(C, F) when is_atom(C) -> + chunk_name_to_id(C, F); + +chunk_id(C, _) -> C. + +chunks_id(Chunks, F) when is_list(Chunks) -> + foldr( + fun(E, L) -> + case chunk_id(E, F) of + C when is_list(hd(C)) -> + C ++ L; + C -> + [C|L] + end + end, + [], + Chunks); + +chunks_id(C, F) -> + chunk_id(C, F). + +%% -> {ok, {Module, Chunks}} | throw(Error) +read_chunks(File, {include, Chunks}) -> + read_significant_chunks(File, chunks_id(Chunks, File)); + +%% -> {ok, {Module, Chunks}} | throw(Error) +read_chunks(File, {exclude, Chunks}) -> + read_chunks(File, foldl(fun(E, L) -> delete(chunk_id(E, File), L) end, all_chunks_list(File), chunks_id(Chunks, File))); + +%% -> {ok, {Module, Chunks}} | throw(Error) +read_chunks(File, Chunks) -> + read_chunk_data(File, chunks_id(Chunks, File), [allow_missing_chunks]). + +%% -> {ok, {Module, Chunks}} | throw(Error) +read_significant_chunks(File, IncChunks) -> + case read_chunks(File, significant_chunks() ++ IncChunks) of + {ok, {Module, Chunks}} -> + {ok, {Module, filter_significant_chunks(Chunks, mandatory_chunks(), File, Module)}} + end. + %% -> {ok, {Module, Chunks}} | throw(Error) read_all_but_useless_chunks(File0) when is_atom(File0); is_list(File0); @@ -452,15 +686,21 @@ read_all_but_useless_chunks(File0) when is_atom(File0); is_useless_chunk("CInf") -> true; is_useless_chunk(_) -> false. -%% -> {ok, {Module, Chunks}} | throw(Error) -read_significant_chunks(File, ChunkList) -> - case read_chunk_data(File, ChunkList, [allow_missing_chunks]) of +read_unstripped_chunks(File) -> + case read_chunk_data(File, unstripped_chunks(), [allow_missing_chunks]) of {ok, {Module, Chunks0}} -> Mandatory = mandatory_chunks(), Chunks = filter_significant_chunks(Chunks0, Mandatory, File, Module), {ok, {Module, Chunks}} end. +%% -> {ok, {Module, Chunks}} | throw(Error) +read_significant_chunks(File) -> + case read_chunks(File, significant_chunks()) of + {ok, {Module, Chunks}} -> + {ok, {Module, filter_significant_chunks(Chunks, mandatory_chunks(), File, Module)}} + end. + filter_significant_chunks([{_, Data}=Pair|Cs], Mandatory, File, Mod) when is_binary(Data) -> [Pair|filter_significant_chunks(Cs, Mandatory, File, Mod)]; @@ -659,6 +899,8 @@ chunk_to_data(atoms=Id, _Chunk, _File, Cs, AtomTable0, _Mod) -> AtomTable = ensure_atoms(AtomTable0, Cs), Atoms = ets:tab2list(AtomTable), {AtomTable, {Id, lists:sort(Atoms)}}; +chunk_to_data(hipe_arch=Id, Chunk, File, _Cs, AtomTable, _Module) -> + {AtomTable, {chunk_name_to_id(Id, File), Chunk}}; % Chunk is a binary chunk_to_data(ChunkName, Chunk, File, Cs, AtomTable, _Mod) when is_atom(ChunkName) -> case catch symbols(Chunk, AtomTable, Cs, ChunkName) of @@ -681,6 +923,10 @@ chunk_name_to_id(labeled_locals, _) -> "LocT"; chunk_name_to_id(attributes, _) -> "Attr"; chunk_name_to_id(abstract_code, _) -> "Abst"; chunk_name_to_id(compile_info, _) -> "CInf"; +chunk_name_to_id(hipe_arch, _) -> hipe_chunk(); +chunk_name_to_id(hipe_arches, File) -> hipe_chunks(File); +chunk_name_to_id(hipe_noarch, File) -> hipe_chunks(File) -- [hipe_chunk()]; +chunk_name_to_id(empty_chunks, File) -> empty_chunks(File); chunk_name_to_id(Other, File) -> error({unknown_chunk, File, Other}). @@ -835,6 +1081,9 @@ file_error(FileName, {error, Reason}) -> error(Reason) -> throw({error, ?MODULE, Reason}). +unstripped_chunks() -> + significant_chunks() ++ ["Attr"]. + %% The following chunks must be kept when stripping a BEAM file. significant_chunks() -> @@ -1077,3 +1326,4 @@ alt_lookup_key([], _) -> error(Fmt, Args) -> error_logger:error_msg(Fmt, Args), error. + diff --git a/lib/stdlib/src/beam_strip.erl b/lib/stdlib/src/beam_strip.erl new file mode 100644 index 0000000..f95b2ec --- /dev/null +++ b/lib/stdlib/src/beam_strip.erl @@ -0,0 +1,193 @@ +-module(beam_strip). + +-define(VERSION, "0.0.1"). + +-vsn(?VERSION). + +-export([start/1, start/0, version/0]). + +-import(getopt, [getopt/4, optval/2]). + +-define(IsUpper(X), X >= $A, X =< $Z). + +-define(UNKNOWN_KEY, 3). +-define(MISSING_KEY_ARG, 4). + +error(E) -> + case E of + {unknown_key, K} -> + io:fwrite("Unknoun key '~s' in command line~n", [K]), + halt(?UNKNOWN_KEY); + _ -> + halt(1) + end. + +usage(O) -> + io:fwrite("Usage: beam_strip [OPTIONS] FILE ...~n"), + lists:foreach( + fun(T) -> + if + element(4, T) -> + SA=" argument", + LA="=argument"; + true -> + SA="", + LA="" + end, + io:fwrite("\t-~s~s|--~s~s~n", [element(3, T), SA, element(2, T), LA]) + end, + O). + +info(Files) -> + lists:foreach( + fun(F) -> + I = beam_lib:info(F), + case lists:keysearch(file, 1, I) of {value, {file, FileName}} -> io:fwrite("File:\t~s~n", [FileName]) end, + case lists:keysearch(module, 1, I) of {value, {module, ModuleName}} -> io:fwrite("Module:\t~s~n", [ModuleName]) end, + case lists:keysearch(chunks, 1, I) of {value, {chunks, Chunks}} -> + io:fwrite("~-6s ~-16s ~s~n", ["Chunk:", "Addr:", "Size:"]), + lists:foreach( + fun(C) -> + case C of {Id, Addr, Size} when is_list(Id), is_integer(Addr), is_integer(Size) -> + io:fwrite("~-6s ~16.16.0B ~10.10B~n", [Id, Addr, Size]) + end + end, + Chunks), + io:nl() + end + end, + Files). + +chunk_ids(L) -> + lists:map( + fun([H|_] = E) -> + if + length(E) =:= 4, ?IsUpper(H) -> E; + true -> list_to_atom(E) + end + end, + L). + +start() -> start([]). + +start(Args) -> + DOpts = [{version, false}, + {help, false}, + {info, false}, + {compress, false}, + {debug, false}, + {empty, true}, + {remove, []}, + {keep, []}, + {hipe, true}, + {arch, false}, + {noarch, true}, + {all, false}], + VOpts = [{info, "info", "i", none}, + {dir, "output", "o", true}, + {compress, "compress", "c", none, true}, + {compress, "no-compress", "C", none, false}, + {debug, "debug", "d", none, true}, + {debug, "debug", "g", none, true}, + {debug, "strip-debug", "S", none, true}, + {empty, "strip-empty", "E", none, true}, + {empty, "keep-empty", "e", none, false}, + {remove, "remove-section", "R", true, true}, + {remove, "remove-chunk", "r", true, true}, + {keep, "keep-section", "K", true, true}, + {keep, "keep-chunk", "k", true, true}, + {hipe, "strip-hipe", "H", none, true}, + {hipe, "keep-hipe", "h", none, false}, + {arch, "strip-arch", "A", none, true}, + {arch, "keep-arch", "a", none, false}, + {noarch, "strip-noarch", "N", none, true}, + {noarch, "keep-noarch", "n", none, false}, + {all, "strip-all", "s", none}, + {version, "version", "V", none}, + {help, "help", "h", none}], + {Opts, Files} = case getopt(init:get_plain_arguments(), VOpts, DOpts, Args) of + {error, Error} -> erlang:error(Error); + O -> O + end, + case optval(help, Opts) of + true -> + usage(VOpts); + _ -> + case optval(info, Opts) of + true -> + info(Files); + _ -> + case optval(version, Opts) of + true -> + version(), + halt; + _ -> + C = case optval(compress, Opts) of + true -> compress; + _ -> nocompress + + end, + F = case optval(dir, Opts) of + none -> Files; + Dir -> {Files, Dir} + end, + case optval(all, Opts) of + true -> + H = case optval(hipe, Opts) of + true -> + case optval(noarch, Opts) of + true -> + case optval(arch, Opts) of + true -> []; + _ -> [hipe_arch] + end; + _ -> + [hipe_arch] + end; + _ -> + [hipe_arches] + end, + if + H =:= [] -> + beam_lib:strip_files(F, C); + true -> + beam_lib:strip_files(F, {include, H}, C) + end; + _ -> + H = case optval(hipe, Opts) of + true -> + [hipe_arches]; + false -> + []; + _ -> + case optval(arch, Opts) of + true -> + [hipe_arches]; + _ -> + case optval(noarch, Opts) of + true -> [hipe_noarches]; + _ -> [] + end + end + end, + R = lists:reverse( + lists:foldl( + fun(E, L) -> + case E of + {remove, V} -> chunk_ids(V) ++ L; + {empty, true} -> [empty_chunks|L]; + {debug, true} -> [abstract_code|L]; + _ -> L + end + end, + [], + Opts)), + beam_lib:strip_files(F, {exclude, case H ++ R of [] -> [empty_chunks]; E -> E end}, C) + end + end + end + end, + halt(). + +version() -> + io:fwrite("~s version ~s~n", [?MODULE, ?VERSION]). diff --git a/lib/stdlib/src/getopt.erl b/lib/stdlib/src/getopt.erl new file mode 100644 index 0000000..f803a17 --- /dev/null +++ b/lib/stdlib/src/getopt.erl @@ -0,0 +1,90 @@ +-module(getopt). + +-vsn("0.0.1"). + +-export([getopt/2, getopt/4, optval/2]). + +normalize_files({Files, Rest}) -> + normalize_files(Files) ++ Rest; + +normalize_files(Files) -> + lists:reverse(Files). + +getopt(List, Valid) -> + getopt(List, Valid, [], []). + +getopt([], _, Opts, Files) -> + {Opts, normalize_files(Files)}; + +getopt(["--"|Rest], _, Opts, Files) -> + getopt([], [], Opts, {Files, Rest}); + +getopt([O|Rest], Valid, Opts, Files) -> + case O of + [$-|SKey] -> + {K, A} = case SKey of + [$-|LKey] -> + case string:chr(LKey, $=) of + 0 -> + {lists:keysearch(LKey, 2, Valid), none}; + EP -> + {lists:keysearch(string:left(LKey, EP-1), 2, Valid), string:substr(LKey, EP+1)} + end; + _ -> + if + length(SKey) =:= 1 -> + {lists:keysearch(SKey, 3, Valid), none}; + true -> + {lists:keysearch(string:left(SKey, 1), 3, Valid), string:substr(SKey, 2)} + end + end, + case K of + false -> + {error, {unknown_key, O}}; + {value, VO} -> + Key = element(1, VO), + if + element(4, VO) -> + if + A =:= none -> + [V|R] = if + Rest =:= [] -> [none]; + true -> Rest + end; + true -> + R = Rest, + V = A + end, + Val = case VO of + {_, _, _, true, true} -> + case optval(Key, Opts) of + none -> + [V]; + PV -> + [V|PV] + end; + _ -> + V + end; + true -> + R = Rest, + Val = case VO of + {_, _, _, none, B} -> + B; + _ -> + true + end + end, + getopt(R, Valid, lists:keystore(Key, 1, Opts, {Key, Val}), Files) + end; + _ -> + getopt(Rest, Valid, Opts, [O|Files]) + end. + +optval(Key, Opts) when is_atom(Key) -> + case lists:keysearch(Key, 1, Opts) of + false -> + none; + {value, {_, Val}} -> + Val + end. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index a30685e..a5de7ff 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -96,7 +96,7 @@ sys, timer, unicode, - win32reg, +%% win32reg, zip]}, {registered,[timer_server,rsh_starter,take_over_monitor,pool_master, dets]},