diff options
Diffstat (limited to 'lib/stdlib/src/escript.erl')
| -rw-r--r-- | lib/stdlib/src/escript.erl | 401 |
1 files changed, 325 insertions, 76 deletions
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 5958a58d7c..bf32e15209 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -19,11 +19,17 @@ -module(escript). %% Useful functions that can be called from scripts. --export([script_name/0, foldl/3]). +-export([script_name/0, create/2, extract/2]). +-export([foldl/3]). % Undocumented function that will be removed %% Internal API. -export([start/0, start/1]). +-include_lib("kernel/include/file.hrl"). + +-define(SHEBANG, "/usr/bin/env escript"). +-define(COMMENT, "This is an -*- erlang -*- file"). + -record(state, {file, module, forms_or_bin, @@ -32,46 +38,247 @@ mode, exports_main, has_records}). - +-record(sections, {type, + shebang, + comment, + emu_args, + body}). +-record(extract_options, {compile_source}). + +-type shebang() :: string(). +-type comment() :: string(). +-type emu_args() :: string(). +-type escript_filename() :: string(). +-type filename() :: string(). +-type zip_file() :: + filename() + | {filename(), binary()} + | {filename(), binary(), #file_info{}}. +-type zip_create_option() :: term(). +-type section() :: + shebang + | {shebang, shebang()} + | comment + | {comment, comment()} + | {emu_args, emu_args()} + | {source, filename() | binary()} + | {beam, filename() | binary()} + | {archive, filename() | binary()} + | {archive, [zip_file()], [zip_create_option()]}. + +%% Create a complete escript file with both header and body +-spec create(escript_filename() | binary, [section()]) -> + ok | {ok, binary()} | {error, term()}. + +create(File, Options) when is_list(Options) -> + try + S = prepare(Options, #sections{}), + BinList = + [Section || Section <- [S#sections.shebang, + S#sections.comment, + S#sections.emu_args, + S#sections.body], + Section =/= undefined], + case File of + binary -> + {ok, list_to_binary(BinList)}; + _ -> + case file:write_file(File, BinList) of + ok -> + ok; + {error, Reason} -> + {error, {Reason, File}} + end + end + catch + throw:PrepareReason -> + {error, PrepareReason} + end. + +prepare([H | T], S) -> + case H of + {shebang, undefined} -> + prepare(T, S); + shebang -> + prepare(T, S#sections{shebang = "#!" ++ ?SHEBANG ++ "\n"}); + {shebang, default} -> + prepare(T, S#sections{shebang = "#!" ++ ?SHEBANG ++ "\n"}); + {shebang, Shebang} when is_list(Shebang) -> + prepare(T, S#sections{shebang = "#!" ++ Shebang ++ "\n"}); + {comment, undefined} -> + prepare(T, S); + comment -> + prepare(T, S#sections{comment = "%% " ++ ?COMMENT ++ "\n"}); + {comment, default} -> + prepare(T, S#sections{comment = "%% " ++ ?COMMENT ++ "\n"}); + {comment, Comment} when is_list(Comment) -> + prepare(T, S#sections{comment = "%% " ++ Comment ++ "\n"}); + {emu_args, undefined} -> + prepare(T, S); + {emu_args, Args} when is_list(Args) -> + prepare(T, S#sections{emu_args = "%%!" ++ Args ++ "\n"}); + {Type, File} when is_list(File) -> + case file:read_file(File) of + {ok, Bin} -> + prepare(T, S#sections{type = Type, body = Bin}); + {error, Reason} -> + throw({Reason, H}) + end; + {Type, Bin} when is_binary(Bin) -> + prepare(T, S#sections{type = Type, body = Bin}); + {archive = Type, ZipFiles, ZipOptions} + when is_list(ZipFiles), is_list(ZipOptions) -> + File = "dummy.zip", + case zip:create(File, ZipFiles, ZipOptions ++ [memory]) of + {ok, {File, ZipBin}} -> + prepare(T, S#sections{type = Type, body = ZipBin}); + {error, Reason} -> + throw({Reason, H}) + end; + _ -> + throw({badarg, H}) + end; +prepare([], #sections{body = undefined}) -> + throw(missing_body); +prepare([], #sections{type = Type} = S) + when Type =:= source; Type =:= beam; Type =:= archive -> + S; +prepare([], #sections{type = Type}) -> + throw({illegal_type, Type}); +prepare(BadOptions, _) -> + throw({badarg, BadOptions}). + +-type section_name() :: shebang | comment | emu_args | body . +-type extract_option() :: compile_source | {section, [section_name()]}. +-spec extract(filename(), [extract_option()]) -> {ok, [section()]} | {error, term()}. +extract(File, Options) when is_list(File), is_list(Options) -> + try + EO = parse_extract_options(Options, + #extract_options{compile_source = false}), + {HeaderSz, NextLineNo, Fd, Sections} = + parse_header(File, not EO#extract_options.compile_source), + Type = Sections#sections.type, + case {Type, EO#extract_options.compile_source} of + {source, true} -> + Bin = compile_source(Type, File, Fd, NextLineNo, HeaderSz); + {_, _} -> + ok = file:close(Fd), + case file:read_file(File) of + {ok, <<_Header:HeaderSz/binary, Bin/binary>>} -> + ok; + {error, ReadReason} -> + Bin = get_rid_of_compiler_warning, + throw(ReadReason) + end + end, + return_sections(Sections, Bin) + catch + throw:Reason -> + {error, Reason} + end. + +parse_extract_options([H | T], EO) -> + case H of + compile_source -> + EO2 = EO#extract_options{compile_source = true}, + parse_extract_options(T, EO2); + _ -> + throw({badarg, H}) + end; +parse_extract_options([], EO) -> + EO. + +compile_source(Type, File, Fd, NextLineNo, HeaderSz) -> + {text, _Module, Forms, _HasRecs, _Mode} = + do_parse_file(Type, File, Fd, NextLineNo, HeaderSz, false), + ok = file:close(Fd), + case compile:forms(Forms, [return_errors, debug_info]) of + {ok, _, BeamBin} -> + BeamBin; + {error, Errors, Warnings} -> + throw({compile, [{errors, format_errors(Errors)}, + {warnings, format_errors(Warnings)}]}) + end. + +format_errors(CompileErrors) -> + [lists:flatten([File, ":", integer_to_list(LineNo), ": ", + Mod:format_error(Error)]) || + {File, FileErrors} <- CompileErrors, + {LineNo, Mod, Error} <- FileErrors]. + +return_sections(S, Bin) -> + {ok, [normalize_section(shebang, S#sections.shebang), + normalize_section(comment, S#sections.comment), + normalize_section(emu_args, S#sections.emu_args), + normalize_section(S#sections.type, Bin)]}. + +normalize_section(Name, undefined) -> + {Name, undefined}; +normalize_section(shebang, "#!" ++ Chars) -> + Chopped = string:strip(Chars, right, $\n), + Stripped = string:strip(Chopped, both), + if + Stripped =:= ?SHEBANG -> + {shebang, default}; + true -> + {shebang, Stripped} + end; +normalize_section(comment, Chars) -> + Chopped = string:strip(Chars, right, $\n), + Stripped = string:strip(string:strip(Chopped, left, $%), both), + if + Stripped =:= ?COMMENT -> + {comment, default}; + true -> + {comment, Stripped} + end; +normalize_section(emu_args, "%%!" ++ Chars) -> + Chopped = string:strip(Chars, right, $\n), + Stripped = string:strip(Chopped, both), + {emu_args, Stripped}; +normalize_section(Name, Chars) -> + {Name, Chars}. + +-spec script_name() -> string(). script_name() -> [ScriptName|_] = init:get_plain_arguments(), ScriptName. %% Apply Fun(Name, GetInfo, GetBin, Acc) for each file in the escript. -%% +%% %% Fun/2 must return a new accumulator which is passed to the next call. %% The function returns the final value of the accumulator. Acc0 is %% returned if the escript contain an empty archive. -%% +%% %% GetInfo/0 is a fun that returns a #file_info{} record for the file. %% GetBin/0 is a fun that returns a the contents of the file as a binary. %% %% An escript may contain erlang code, beam code or an archive: %% -%% archive - the Fun/2 will be applied for each file in the archive -%% beam - the Fun/2 will be applied once and GetInfo/0 returns the file +%% archive - the Fun/4 will be applied for each file in the archive +%% beam - the Fun/4 will be applied once and GetInfo/0 returns the file %% info for the (entire) escript file -%% erl - the Fun/2 will be applied once, GetInfo/0 returns the file +%% erl - the Fun/4 will be applied once, GetInfo/0 returns the file %% info for the (entire) escript file and the GetBin returns %% the compiled beam code -%%-spec foldl(fun((string(), -%% fun(() -> #file_info()), -%% fun(() -> binary() -> term()), -%% term()) -> term()), -%% term(), -%% string()). +-spec foldl(fun((string(), + fun(() -> #file_info{}), + fun(() -> binary()), + term()) -> term()), + term(), + string()) -> {ok, term()} | {error, term()}. foldl(Fun, Acc0, File) when is_function(Fun, 4) -> case parse_file(File, false) of {text, _, Forms, _HasRecs, _Mode} when is_list(Forms) -> - GetInfo = fun() -> file:read_file_info(File) end, + GetInfo = fun() -> {ok, FI} = file:read_file_info(File), FI end, GetBin = fun() -> case compile:forms(Forms, [return_errors, debug_info]) of {ok, _, BeamBin} -> BeamBin; {error, _Errors, _Warnings} -> - fatal("There were compilation errors.") + throw("There were compilation errors.") end end, try @@ -81,7 +288,7 @@ foldl(Fun, Acc0, File) when is_function(Fun, 4) -> {error, Reason} end; {beam, _, BeamBin, _HasRecs, _Mode} when is_binary(BeamBin) -> - GetInfo = fun() -> file:read_file_info(File) end, + GetInfo = fun() -> {ok, FI} = file:read_file_info(File), FI end, GetBin = fun() -> BeamBin end, try {ok, Fun(".", GetInfo, GetBin, Acc0)} @@ -110,11 +317,13 @@ foldl(Fun, Acc0, File) when is_function(Fun, 4) -> %% Internal API. %% +-spec start() -> no_return(). start() -> start([]). +-spec start([string()]) -> no_return(). start(EscriptOptions) -> - try + try %% Commands run using -run or -s are run in a process %% trap_exit set to false. Because this behaviour is %% surprising for users of escript, make sure to reset @@ -143,11 +352,11 @@ parse_and_run(File, Args, Options) -> parse_file(File, CheckOnly), Mode2 = case lists:member("d", Options) of - true -> + true -> debug; false -> case lists:member("c", Options) of - true -> + true -> compile; false -> case lists:member("i", Options) of @@ -177,7 +386,7 @@ parse_and_run(File, Args, Options) -> _Other -> fatal("There were compilation errors.") end - end; + end; is_binary(FormsOrBin) -> case Source of archive -> @@ -190,11 +399,13 @@ parse_and_run(File, Args, Options) -> true -> my_halt(0); false -> - Text = lists:concat(["Function ", Module, ":main/1 is not exported"]), + Text = lists:concat(["Function ", Module, + ":main/1 is not exported"]), fatal(Text) end; _ -> - Text = lists:concat(["Cannot load module ", Module, " from archive"]), + Text = lists:concat(["Cannot load module ", Module, + " from archive"]), fatal(Text) end; ok -> @@ -212,7 +423,7 @@ parse_and_run(File, Args, Options) -> run -> {module, Module} = code:load_binary(Module, File, FormsOrBin), run(Module, Args); - debug -> + debug -> [Base | Rest] = lists:reverse(filename:split(File)), Base2 = filename:basename(Base, code:objfile_extension()), Rest2 = @@ -222,8 +433,8 @@ parse_and_run(File, Args, Options) -> end, SrcFile = filename:join(lists:reverse([Base2 ++ ".erl" | Rest2])), debug(Module, {Module, SrcFile, File, FormsOrBin}, Args) - end - end + end + end end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -231,25 +442,19 @@ parse_and_run(File, Args, Options) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% parse_file(File, CheckOnly) -> - S = #state{file = File, - n_errors = 0, - mode = interpret, - exports_main = false, - has_records = false}, - {ok, Fd} = - case file:open(File, [read]) of - {ok, Fd0} -> - {ok, Fd0}; - {error, R} -> - fatal(lists:concat([file:format_error(R), ": '", File, "'"])) - end, - {HeaderSz, StartLine, ScriptType} = skip_header(Fd, 1), + {HeaderSz, NextLineNo, Fd, Sections} = + parse_header(File, false), + do_parse_file(Sections#sections.type, + File, Fd, NextLineNo, HeaderSz, CheckOnly). + +do_parse_file(Type, File, Fd, NextLineNo, HeaderSz, CheckOnly) -> + S = initial_state(File), #state{mode = Mode, source = Source, module = Module, forms_or_bin = FormsOrBin, has_records = HasRecs} = - case ScriptType of + case Type of archive -> %% Archive file ok = file:close(Fd), @@ -260,51 +465,93 @@ parse_file(File, CheckOnly) -> parse_beam(S, File, HeaderSz, CheckOnly); source -> %% Source code - parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) + parse_source(S, File, Fd, NextLineNo, HeaderSz, CheckOnly) end, {Source, Module, FormsOrBin, HasRecs, Mode}. +initial_state(File) -> + #state{file = File, + n_errors = 0, + mode = interpret, + exports_main = false, + has_records = false}. + %% Skip header and make a heuristic guess about the script type -skip_header(P, LineNo) -> +parse_header(File, KeepFirst) -> + LineNo = 1, + {ok, Fd} = + case file:open(File, [read]) of + {ok, Fd0} -> + {ok, Fd0}; + {error, R} -> + fatal(lists:concat([file:format_error(R), ": '", File, "'"])) + end, + %% Skip shebang on first line - {ok, HeaderSz0} = file:position(P, cur), - Line1 = get_line(P), + {ok, HeaderSz0} = file:position(Fd, cur), + Line1 = get_line(Fd), case classify_line(Line1) of shebang -> - find_first_body_line(P, LineNo); + find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, + #sections{shebang = Line1}); archive -> - {HeaderSz0, LineNo, archive}; + {HeaderSz0, LineNo, Fd, + #sections{type = archive}}; beam -> - {HeaderSz0, LineNo, beam}; + {HeaderSz0, LineNo, Fd, + #sections{type = beam}}; _ -> - find_first_body_line(P, LineNo) + find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, + #sections{}) end. -find_first_body_line(P, LineNo) -> - {ok, HeaderSz1} = file:position(P, cur), +find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> + {ok, HeaderSz1} = file:position(Fd, cur), %% Look for special comment on second line - Line2 = get_line(P), - {ok, HeaderSz2} = file:position(P, cur), + Line2 = get_line(Fd), + {ok, HeaderSz2} = file:position(Fd, cur), case classify_line(Line2) of emu_args -> %% Skip special comment on second line - Line3 = get_line(P), - {HeaderSz2, LineNo + 2, guess_type(Line3)}; - _ -> + Line3 = get_line(Fd), + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = undefined, + emu_args = Line2}}; + Line2Type -> %% Look for special comment on third line - Line3 = get_line(P), - {ok, HeaderSz3} = file:position(P, cur), - case classify_line(Line3) of - emu_args -> + Line3 = get_line(Fd), + {ok, HeaderSz3} = file:position(Fd, cur), + Line3Type = classify_line(Line3), + if + Line3Type =:= emu_args -> %% Skip special comment on third line - Line4 = get_line(P), - {HeaderSz3, LineNo + 3, guess_type(Line4)}; - _ -> + Line4 = get_line(Fd), + {HeaderSz3, LineNo + 3, Fd, + Sections#sections{type = guess_type(Line4), + comment = Line2, + emu_args = Line3}}; + Sections#sections.shebang =:= undefined, + KeepFirst =:= true -> + %% No shebang. Use the entire file + {HeaderSz0, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Sections#sections.shebang =:= undefined -> + %% No shebang. Skip the first line + {HeaderSz1, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Line2Type =:= comment -> + %% Skip shebang on first line and comment on second + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = Line2}}; + true -> %% Just skip shebang on first line - {HeaderSz1, LineNo + 1, guess_type(Line2)} + {HeaderSz1, LineNo + 1, Fd, + Sections#sections{type = guess_type(Line2)}} end end. - + classify_line(Line) -> case Line of [$\#, $\! | _] -> @@ -313,8 +560,10 @@ classify_line(Line) -> archive; [$F, $O, $R, $1 | _] -> beam; - [$\%, $\%, $\! | _] -> + [$%, $%, $\! | _] -> emu_args; + [$% | _] -> + comment; _ -> undefined end. @@ -336,8 +585,8 @@ get_line(P) -> parse_archive(S, File, HeaderSz) -> case file:read_file(File) of - {ok, <<_FirstLine:HeaderSz/binary, Bin/binary>>} -> - Mod = + {ok, <<_Header:HeaderSz/binary, Bin/binary>>} -> + Mod = case init:get_argument(escript) of {ok, [["main", M]]} -> %% Use explicit module name @@ -345,14 +594,14 @@ parse_archive(S, File, HeaderSz) -> _ -> %% Use escript name without extension as module name RevBase = lists:reverse(filename:basename(File)), - RevBase2 = + RevBase2 = case lists:dropwhile(fun(X) -> X =/= $. end, RevBase) of [$. | Rest] -> Rest; [] -> RevBase end, list_to_atom(lists:reverse(RevBase2)) end, - + S#state{source = archive, mode = run, module = Mod, @@ -365,7 +614,7 @@ parse_archive(S, File, HeaderSz) -> parse_beam(S, File, HeaderSz, CheckOnly) -> - {ok, <<_FirstLine:HeaderSz/binary, Bin/binary>>} = + {ok, <<_Header:HeaderSz/binary, Bin/binary>>} = file:read_file(File), case beam_lib:chunks(Bin, [exports]) of {ok, {Module, [{exports, Exports}]}} -> @@ -399,7 +648,7 @@ parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> {ok, FileForm} = epp:parse_erl_form(Epp), OptModRes = epp:parse_erl_form(Epp), S2 = S#state{source = text, module = Module}, - S3 = + S3 = case OptModRes of {ok, {attribute,_, module, M} = Form} -> epp_parse_file(Epp, S2#state{module = M}, [Form, FileForm]); @@ -448,12 +697,12 @@ check_source(S, CheckOnly) -> pre_def_macros(File) -> {MegaSecs, Secs, MicroSecs} = erlang:now(), - Replace = fun(Char) -> + Replace = fun(Char) -> case Char of $\. -> $\_; _ -> Char end - end, + end, CleanBase = lists:map(Replace, filename:basename(File)), ModuleStr = CleanBase ++ "__" ++ @@ -642,8 +891,8 @@ eval_exprs([E|Es], Bs0, Lf, Ef, RBs) -> eval_exprs(Es, Bs, Lf, Ef, RBs). format_exception(Class, Reason) -> - PF = fun(Term, I) -> - io_lib:format("~." ++ integer_to_list(I) ++ "P", [Term, 50]) + PF = fun(Term, I) -> + io_lib:format("~." ++ integer_to_list(I) ++ "P", [Term, 50]) end, StackTrace = erlang:get_stacktrace(), StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, @@ -651,7 +900,7 @@ format_exception(Class, Reason) -> fatal(Str) -> throw(Str). - + my_halt(Reason) -> case process_info(group_leader(), status) of {_,waiting} -> @@ -675,7 +924,7 @@ hidden_apply(App, M, F, Args) -> Arity = length(Args), Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n", [M, F, Arity, App]), - fatal(Text); + fatal(Text); Stk -> erlang:raise(error, undef, Stk) end |