mirror of
https://github.com/processone/ejabberd.git
synced 2024-12-28 17:38:54 +01:00
* src/ejabberd_loglevel.erl: Use dynamic_compile instead of
ram_file_io_server. Support definition of loglevels with integer or atom. (thanks to Geoff Cant)(EJAB-919) * src/dynamic_compile.erl: Added erlang module that converts string to binary loadable code by Mats Cronqvist, Chris Newcombe, and Jacob Vorreuter. * src/ram_file_io_server.erl: Remove file not longer useful. * src/ejabberd.app: Likewise SVN Revision: 2054
This commit is contained in:
parent
e202ec009e
commit
921c7ede0d
11
ChangeLog
11
ChangeLog
@ -1,3 +1,14 @@
|
|||||||
|
2009-05-06 Badlop <badlop@process-one.net>
|
||||||
|
|
||||||
|
* src/ejabberd_loglevel.erl: Use dynamic_compile instead of
|
||||||
|
ram_file_io_server. Support definition of loglevels with integer
|
||||||
|
or atom. (thanks to Geoff Cant)(EJAB-919)
|
||||||
|
* src/dynamic_compile.erl: Added erlang module that converts
|
||||||
|
string to binary loadable code by Mats Cronqvist, Chris Newcombe,
|
||||||
|
and Jacob Vorreuter.
|
||||||
|
* src/ram_file_io_server.erl: Remove file not longer useful.
|
||||||
|
* src/ejabberd.app: Likewise
|
||||||
|
|
||||||
2009-05-03 Badlop <badlop@process-one.net>
|
2009-05-03 Badlop <badlop@process-one.net>
|
||||||
|
|
||||||
* src/mod_muc/mod_muc_room.erl: Fix badarg return (EJAB-899)
|
* src/mod_muc/mod_muc_room.erl: Fix badarg return (EJAB-899)
|
||||||
|
268
src/dynamic_compile.erl
Normal file
268
src/dynamic_compile.erl
Normal file
@ -0,0 +1,268 @@
|
|||||||
|
%% Copyright (c) 2007
|
||||||
|
%% Mats Cronqvist <mats.cronqvist@ericsson.com>
|
||||||
|
%% Chris Newcombe <chris.newcombe@gmail.com>
|
||||||
|
%% Jacob Vorreuter <jacob.vorreuter@gmail.com>
|
||||||
|
%%
|
||||||
|
%% Permission is hereby granted, free of charge, to any person
|
||||||
|
%% obtaining a copy of this software and associated documentation
|
||||||
|
%% files (the "Software"), to deal in the Software without
|
||||||
|
%% restriction, including without limitation the rights to use,
|
||||||
|
%% copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||||
|
%% copies of the Software, and to permit persons to whom the
|
||||||
|
%% Software is furnished to do so, subject to the following
|
||||||
|
%% conditions:
|
||||||
|
%%
|
||||||
|
%% The above copyright notice and this permission notice shall be
|
||||||
|
%% included in all copies or substantial portions of the Software.
|
||||||
|
%%
|
||||||
|
%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
|
||||||
|
%% OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||||
|
%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||||
|
%% HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||||
|
%% WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
%% FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
||||||
|
%% OTHER DEALINGS IN THE SOFTWARE.
|
||||||
|
|
||||||
|
%%%-------------------------------------------------------------------
|
||||||
|
%%% File : dynamic_compile.erl
|
||||||
|
%%% Description :
|
||||||
|
%%% Authors : Mats Cronqvist <mats.cronqvist@ericsson.com>
|
||||||
|
%%% Chris Newcombe <chris.newcombe@gmail.com>
|
||||||
|
%%% Jacob Vorreuter <jacob.vorreuter@gmail.com>
|
||||||
|
%%% TODO :
|
||||||
|
%%% - add support for limit include-file depth (and prevent circular references)
|
||||||
|
%%% prevent circular macro expansion set FILE correctly when -module() is found
|
||||||
|
%%% -include_lib support $ENVVAR in include filenames
|
||||||
|
%%% substitute-stringize (??MACRO)
|
||||||
|
%%% -undef/-ifdef/-ifndef/-else/-endif
|
||||||
|
%%% -file(File, Line)
|
||||||
|
%%%-------------------------------------------------------------------
|
||||||
|
-module(dynamic_compile).
|
||||||
|
|
||||||
|
%% API
|
||||||
|
-export([from_string/1, from_string/2]).
|
||||||
|
|
||||||
|
-import(lists, [reverse/1, keyreplace/4]).
|
||||||
|
|
||||||
|
%%====================================================================
|
||||||
|
%% API
|
||||||
|
%%====================================================================
|
||||||
|
%%--------------------------------------------------------------------
|
||||||
|
%% Function:
|
||||||
|
%% Description:
|
||||||
|
%% Returns a binary that can be used with
|
||||||
|
%% code:load_binary(Module, ModuleFilenameForInternalRecords, Binary).
|
||||||
|
%%--------------------------------------------------------------------
|
||||||
|
from_string(CodeStr) ->
|
||||||
|
from_string(CodeStr, []).
|
||||||
|
|
||||||
|
% takes Options as for compile:forms/2
|
||||||
|
from_string(CodeStr, CompileFormsOptions) ->
|
||||||
|
%% Initialise the macro dictionary with the default predefined macros,
|
||||||
|
%% (adapted from epp.erl:predef_macros/1
|
||||||
|
Filename = "compiled_from_string",
|
||||||
|
%%Machine = list_to_atom(erlang:system_info(machine)),
|
||||||
|
Ms0 = dict:new(),
|
||||||
|
% Ms1 = dict:store('FILE', {[], "compiled_from_string"}, Ms0),
|
||||||
|
% Ms2 = dict:store('LINE', {[], 1}, Ms1), % actually we might add special code for this
|
||||||
|
% Ms3 = dict:store('MODULE', {[], undefined}, Ms2),
|
||||||
|
% Ms4 = dict:store('MODULE_STRING', {[], undefined}, Ms3),
|
||||||
|
% Ms5 = dict:store('MACHINE', {[], Machine}, Ms4),
|
||||||
|
% InitMD = dict:store(Machine, {[], true}, Ms5),
|
||||||
|
InitMD = Ms0,
|
||||||
|
|
||||||
|
%% From the docs for compile:forms:
|
||||||
|
%% When encountering an -include or -include_dir directive, the compiler searches for header files in the following directories:
|
||||||
|
%% 1. ".", the current working directory of the file server;
|
||||||
|
%% 2. the base name of the compiled file;
|
||||||
|
%% 3. the directories specified using the i option. The directory specified last is searched first.
|
||||||
|
%% In this case, #2 is meaningless.
|
||||||
|
IncludeSearchPath = ["." | reverse([Dir || {i, Dir} <- CompileFormsOptions])],
|
||||||
|
{RevForms, _OutMacroDict} = scan_and_parse(CodeStr, Filename, 1, [], InitMD, IncludeSearchPath),
|
||||||
|
Forms = reverse(RevForms),
|
||||||
|
|
||||||
|
%% note: 'binary' is forced as an implicit option, whether it is provided or not.
|
||||||
|
case compile:forms(Forms, CompileFormsOptions) of
|
||||||
|
{ok, ModuleName, CompiledCodeBinary} when is_binary(CompiledCodeBinary) ->
|
||||||
|
{ModuleName, CompiledCodeBinary};
|
||||||
|
{ok, ModuleName, CompiledCodeBinary, []} when is_binary(CompiledCodeBinary) -> % empty warnings list
|
||||||
|
{ModuleName, CompiledCodeBinary};
|
||||||
|
{ok, _ModuleName, _CompiledCodeBinary, Warnings} ->
|
||||||
|
throw({?MODULE, warnings, Warnings});
|
||||||
|
Other ->
|
||||||
|
throw({?MODULE, compile_forms, Other})
|
||||||
|
end.
|
||||||
|
|
||||||
|
%%====================================================================
|
||||||
|
%% Internal functions
|
||||||
|
%%====================================================================
|
||||||
|
%%% Code from Mats Cronqvist
|
||||||
|
%%% See http://www.erlang.org/pipermail/erlang-questions/2007-March/025507.html
|
||||||
|
%%%## 'scan_and_parse'
|
||||||
|
%%%
|
||||||
|
%%% basically we call the OTP scanner and parser (erl_scan and
|
||||||
|
%%% erl_parse) line-by-line, but check each scanned line for (or
|
||||||
|
%%% definitions of) macros before parsing.
|
||||||
|
%% returns {ReverseForms, FinalMacroDict}
|
||||||
|
scan_and_parse([], _CurrFilename, _CurrLine, RevForms, MacroDict, _IncludeSearchPath) ->
|
||||||
|
{RevForms, MacroDict};
|
||||||
|
|
||||||
|
scan_and_parse(RemainingText, CurrFilename, CurrLine, RevForms, MacroDict, IncludeSearchPath) ->
|
||||||
|
case scanner(RemainingText, CurrLine, MacroDict) of
|
||||||
|
{tokens, NLine, NRemainingText, Toks} ->
|
||||||
|
{ok, Form} = erl_parse:parse_form(Toks),
|
||||||
|
scan_and_parse(NRemainingText, CurrFilename, NLine, [Form | RevForms], MacroDict, IncludeSearchPath);
|
||||||
|
{macro, NLine, NRemainingText, NMacroDict} ->
|
||||||
|
scan_and_parse(NRemainingText, CurrFilename, NLine, RevForms,NMacroDict, IncludeSearchPath);
|
||||||
|
{include, NLine, NRemainingText, IncludeFilename} ->
|
||||||
|
IncludeFileRemainingTextents = read_include_file(IncludeFilename, IncludeSearchPath),
|
||||||
|
%%io:format("include file ~p contents: ~n~p~nRemainingText = ~p~n", [IncludeFilename,IncludeFileRemainingTextents, RemainingText]),
|
||||||
|
%% Modify the FILE macro to reflect the filename
|
||||||
|
%%IncludeMacroDict = dict:store('FILE', {[],IncludeFilename}, MacroDict),
|
||||||
|
IncludeMacroDict = MacroDict,
|
||||||
|
|
||||||
|
%% Process the header file (inc. any nested header files)
|
||||||
|
{RevIncludeForms, IncludedMacroDict} = scan_and_parse(IncludeFileRemainingTextents, IncludeFilename, 1, [], IncludeMacroDict, IncludeSearchPath),
|
||||||
|
%io:format("include file results = ~p~n", [R]),
|
||||||
|
%% Restore the FILE macro in the NEW MacroDict (so we keep any macros defined in the header file)
|
||||||
|
%%NMacroDict = dict:store('FILE', {[],CurrFilename}, IncludedMacroDict),
|
||||||
|
NMacroDict = IncludedMacroDict,
|
||||||
|
|
||||||
|
%% Continue with the original file
|
||||||
|
scan_and_parse(NRemainingText, CurrFilename, NLine, RevIncludeForms ++ RevForms, NMacroDict, IncludeSearchPath);
|
||||||
|
done ->
|
||||||
|
scan_and_parse([], CurrFilename, CurrLine, RevForms, MacroDict, IncludeSearchPath)
|
||||||
|
end.
|
||||||
|
|
||||||
|
scanner(Text, Line, MacroDict) ->
|
||||||
|
case erl_scan:tokens([],Text,Line) of
|
||||||
|
{done, {ok,Toks,NLine}, LeftOverChars} ->
|
||||||
|
case pre_proc(Toks, MacroDict) of
|
||||||
|
{tokens, NToks} -> {tokens, NLine, LeftOverChars, NToks};
|
||||||
|
{macro, NMacroDict} -> {macro, NLine, LeftOverChars, NMacroDict};
|
||||||
|
{include, Filename} -> {include, NLine, LeftOverChars, Filename}
|
||||||
|
end;
|
||||||
|
{more, _Continuation} ->
|
||||||
|
%% This is supposed to mean "term is not yet complete" (i.e. a '.' has
|
||||||
|
%% not been reached yet).
|
||||||
|
%% However, for some bizarre reason we also get this if there is a comment after the final '.' in a file.
|
||||||
|
%% So we check to see if Text only consists of comments.
|
||||||
|
case is_only_comments(Text) of
|
||||||
|
true ->
|
||||||
|
done;
|
||||||
|
false ->
|
||||||
|
throw({incomplete_term, Text, Line})
|
||||||
|
end
|
||||||
|
end.
|
||||||
|
|
||||||
|
is_only_comments(Text) -> is_only_comments(Text, not_in_comment).
|
||||||
|
|
||||||
|
is_only_comments([], _) -> true;
|
||||||
|
is_only_comments([$ |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
|
||||||
|
is_only_comments([$\t |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
|
||||||
|
is_only_comments([$\n |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
|
||||||
|
is_only_comments([$% |T], not_in_comment) -> is_only_comments(T, in_comment); % found start of a comment
|
||||||
|
is_only_comments(_, not_in_comment) -> false;
|
||||||
|
% found any significant char NOT in a comment
|
||||||
|
is_only_comments([$\n |T], in_comment) -> is_only_comments(T, not_in_comment); % found end of a comment
|
||||||
|
is_only_comments([_ |T], in_comment) -> is_only_comments(T, in_comment). % skipping over in-comment chars
|
||||||
|
|
||||||
|
%%%## 'pre-proc'
|
||||||
|
%%%
|
||||||
|
%%% have to implement a subset of the pre-processor, since epp insists
|
||||||
|
%%% on running on a file.
|
||||||
|
%%% only handles 2 cases;
|
||||||
|
%% -define(MACRO, something).
|
||||||
|
%% -define(MACRO(VAR1,VARN),{stuff,VAR1,more,stuff,VARN,extra,stuff}).
|
||||||
|
pre_proc([{'-',_},{atom,_,define},{'(',_},{_,_,Name}|DefToks],MacroDict) ->
|
||||||
|
false = dict:is_key(Name, MacroDict),
|
||||||
|
case DefToks of
|
||||||
|
[{',',_} | Macro] ->
|
||||||
|
{macro, dict:store(Name, {[], macro_body_def(Macro, [])}, MacroDict)};
|
||||||
|
[{'(',_} | Macro] ->
|
||||||
|
{macro, dict:store(Name, macro_params_body_def(Macro, []), MacroDict)}
|
||||||
|
end;
|
||||||
|
|
||||||
|
pre_proc([{'-',_}, {atom,_,include}, {'(',_}, {string,_,Filename}, {')',_}, {dot,_}], _MacroDict) ->
|
||||||
|
{include, Filename};
|
||||||
|
|
||||||
|
pre_proc(Toks,MacroDict) ->
|
||||||
|
{tokens, subst_macros(Toks, MacroDict)}.
|
||||||
|
|
||||||
|
macro_params_body_def([{')',_},{',',_} | Toks], RevParams) ->
|
||||||
|
{reverse(RevParams), macro_body_def(Toks, [])};
|
||||||
|
macro_params_body_def([{var,_,Param} | Toks], RevParams) ->
|
||||||
|
macro_params_body_def(Toks, [Param | RevParams]);
|
||||||
|
macro_params_body_def([{',',_}, {var,_,Param} | Toks], RevParams) ->
|
||||||
|
macro_params_body_def(Toks, [Param | RevParams]).
|
||||||
|
|
||||||
|
macro_body_def([{')',_}, {dot,_}], RevMacroBodyToks) ->
|
||||||
|
reverse(RevMacroBodyToks);
|
||||||
|
macro_body_def([Tok|Toks], RevMacroBodyToks) ->
|
||||||
|
macro_body_def(Toks, [Tok | RevMacroBodyToks]).
|
||||||
|
|
||||||
|
subst_macros(Toks, MacroDict) ->
|
||||||
|
reverse(subst_macros_rev(Toks, MacroDict, [])).
|
||||||
|
|
||||||
|
%% returns a reversed list of tokes
|
||||||
|
subst_macros_rev([{'?',_}, {_,LineNum,'LINE'} | Toks], MacroDict, RevOutToks) ->
|
||||||
|
%% special-case for ?LINE, to avoid creating a new MacroDict for every line in the source file
|
||||||
|
subst_macros_rev(Toks, MacroDict, [{integer,LineNum,LineNum}] ++ RevOutToks);
|
||||||
|
|
||||||
|
subst_macros_rev([{'?',_}, {_,_,Name}, {'(',_} = Paren | Toks], MacroDict, RevOutToks) ->
|
||||||
|
case dict:fetch(Name, MacroDict) of
|
||||||
|
{[], MacroValue} ->
|
||||||
|
%% This macro does not have any vars, so ignore the fact that the invocation is followed by "(...stuff"
|
||||||
|
%% Recursively expand any macro calls inside this macro's value
|
||||||
|
%% TODO: avoid infinite expansion due to circular references (even indirect ones)
|
||||||
|
RevExpandedOtherMacrosToks = subst_macros_rev(MacroValue, MacroDict, []),
|
||||||
|
subst_macros_rev([Paren|Toks], MacroDict, RevExpandedOtherMacrosToks ++ RevOutToks);
|
||||||
|
ParamsAndBody ->
|
||||||
|
%% This macro does have vars.
|
||||||
|
%% Collect all of the passe arguments, in an ordered list
|
||||||
|
{NToks, Arguments} = subst_macros_get_args(Toks, []),
|
||||||
|
%% Expand the varibles
|
||||||
|
ExpandedParamsToks = subst_macros_subst_args_for_vars(ParamsAndBody, Arguments),
|
||||||
|
%% Recursively expand any macro calls inside this macro's value
|
||||||
|
%% TODO: avoid infinite expansion due to circular references (even indirect ones)
|
||||||
|
RevExpandedOtherMacrosToks = subst_macros_rev(ExpandedParamsToks, MacroDict, []),
|
||||||
|
subst_macros_rev(NToks, MacroDict, RevExpandedOtherMacrosToks ++ RevOutToks)
|
||||||
|
end;
|
||||||
|
|
||||||
|
subst_macros_rev([{'?',_}, {_,_,Name} | Toks], MacroDict, RevOutToks) ->
|
||||||
|
%% This macro invocation does not have arguments.
|
||||||
|
%% Therefore the definition should not have parameters
|
||||||
|
{[], MacroValue} = dict:fetch(Name, MacroDict),
|
||||||
|
|
||||||
|
%% Recursively expand any macro calls inside this macro's value
|
||||||
|
%% TODO: avoid infinite expansion due to circular references (even indirect ones)
|
||||||
|
RevExpandedOtherMacrosToks = subst_macros_rev(MacroValue, MacroDict, []),
|
||||||
|
subst_macros_rev(Toks, MacroDict, RevExpandedOtherMacrosToks ++ RevOutToks);
|
||||||
|
|
||||||
|
subst_macros_rev([Tok|Toks], MacroDict, RevOutToks) ->
|
||||||
|
subst_macros_rev(Toks, MacroDict, [Tok|RevOutToks]);
|
||||||
|
subst_macros_rev([], _MacroDict, RevOutToks) -> RevOutToks.
|
||||||
|
|
||||||
|
subst_macros_get_args([{')',_} | Toks], RevArgs) ->
|
||||||
|
{Toks, reverse(RevArgs)};
|
||||||
|
subst_macros_get_args([{',',_}, {var,_,ArgName} | Toks], RevArgs) ->
|
||||||
|
subst_macros_get_args(Toks, [ArgName| RevArgs]);
|
||||||
|
subst_macros_get_args([{var,_,ArgName} | Toks], RevArgs) ->
|
||||||
|
subst_macros_get_args(Toks, [ArgName | RevArgs]).
|
||||||
|
|
||||||
|
subst_macros_subst_args_for_vars({[], BodyToks}, []) ->
|
||||||
|
BodyToks;
|
||||||
|
subst_macros_subst_args_for_vars({[Param | Params], BodyToks}, [Arg|Args]) ->
|
||||||
|
NBodyToks = keyreplace(Param, 3, BodyToks, {var,1,Arg}),
|
||||||
|
subst_macros_subst_args_for_vars({Params, NBodyToks}, Args).
|
||||||
|
|
||||||
|
read_include_file(Filename, IncludeSearchPath) ->
|
||||||
|
case file:path_open(IncludeSearchPath, Filename, [read, raw, binary]) of
|
||||||
|
{ok, IoDevice, FullName} ->
|
||||||
|
{ok, Data} = file:read(IoDevice, filelib:file_size(FullName)),
|
||||||
|
file:close(IoDevice),
|
||||||
|
binary_to_list(Data);
|
||||||
|
{error, Reason} ->
|
||||||
|
throw({failed_to_read_include_file, Reason, Filename, IncludeSearchPath})
|
||||||
|
end.
|
@ -115,7 +115,6 @@
|
|||||||
nodetree_virtual,
|
nodetree_virtual,
|
||||||
p1_fsm,
|
p1_fsm,
|
||||||
p1_mnesia,
|
p1_mnesia,
|
||||||
ram_file_io_server,
|
|
||||||
randoms,
|
randoms,
|
||||||
sha,
|
sha,
|
||||||
shaper,
|
shaper,
|
||||||
|
@ -38,51 +38,30 @@
|
|||||||
-define(LOGMODULE, "error_logger").
|
-define(LOGMODULE, "error_logger").
|
||||||
|
|
||||||
%% Error levels:
|
%% Error levels:
|
||||||
%% 0 -> No log
|
-define(LOG_LEVELS,[ {0, no_log, "No log"}
|
||||||
%% 1 -> Critical
|
,{1, critical, "Critical"}
|
||||||
%% 2 -> Error
|
,{2, error, "Error"}
|
||||||
%% 3 -> Warning
|
,{3, warning, "Warning"}
|
||||||
%% 4 -> Info
|
,{4, info, "Info"}
|
||||||
%% 5 -> Debug
|
,{5, debug, "Debug"}
|
||||||
|
]).
|
||||||
|
|
||||||
|
set(LogLevel) when is_atom(LogLevel) ->
|
||||||
|
set(level_to_integer(LogLevel));
|
||||||
set(Loglevel) when is_integer(Loglevel) ->
|
set(Loglevel) when is_integer(Loglevel) ->
|
||||||
Forms = compile_string(?LOGMODULE, ejabberd_logger_src(Loglevel)),
|
try
|
||||||
load_logger(Forms, ?LOGMODULE, Loglevel);
|
{Mod,Code} = dynamic_compile:from_string(ejabberd_logger_src(Loglevel)),
|
||||||
|
code:load_binary(Mod, ?LOGMODULE ++ ".erl", Code)
|
||||||
|
catch
|
||||||
|
Type:Error -> ?CRITICAL_MSG("Error compiling logger (~p): ~p~n", [Type, Error])
|
||||||
|
end;
|
||||||
set(_) ->
|
set(_) ->
|
||||||
exit("Loglevel must be an integer").
|
exit("Loglevel must be an integer").
|
||||||
|
|
||||||
%% --------------------------------------------------------------
|
level_to_integer(Level) ->
|
||||||
%% Compile a string into a module and returns the binary
|
case lists:keyfind(Level, 2, ?LOG_LEVELS) of
|
||||||
compile_string(Mod, Str) ->
|
{Int, Level, _Desc} -> Int;
|
||||||
Fname = Mod ++ ".erl",
|
_ -> erlang:error({no_such_loglevel, Level})
|
||||||
{ok, Fd} = open_ram_file(Fname),
|
|
||||||
file:write(Fd, Str),
|
|
||||||
file:position(Fd, 0),
|
|
||||||
case epp_dodger:parse(Fd) of
|
|
||||||
{ok, Tree} ->
|
|
||||||
Forms = revert_tree(Tree),
|
|
||||||
close_ram_file(Fd),
|
|
||||||
Forms;
|
|
||||||
Error ->
|
|
||||||
close_ram_file(Fd),
|
|
||||||
Error
|
|
||||||
end.
|
|
||||||
|
|
||||||
open_ram_file(Fname) ->
|
|
||||||
ram_file_io_server:start(self(), Fname, [read,write]).
|
|
||||||
|
|
||||||
close_ram_file(Fd) ->
|
|
||||||
file:close(Fd).
|
|
||||||
|
|
||||||
revert_tree(Tree) ->
|
|
||||||
[erl_syntax:revert(T) || T <- Tree].
|
|
||||||
|
|
||||||
load_logger(Forms, Mod, Loglevel) ->
|
|
||||||
Fname = Mod ++ ".erl",
|
|
||||||
case compile:forms(Forms, [binary, {d,'LOGLEVEL',Loglevel}]) of
|
|
||||||
{ok, M, Bin} ->
|
|
||||||
code:load_binary(M, Fname, Bin);
|
|
||||||
Error ->
|
|
||||||
?CRITICAL_MSG("Error ~p~n", [Error])
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
%% --------------------------------------------------------------
|
%% --------------------------------------------------------------
|
||||||
|
@ -1,408 +0,0 @@
|
|||||||
%% ``The contents of this file are subject to the Erlang Public License,
|
|
||||||
%% Version 1.1, (the "License"); you may not use this file except in
|
|
||||||
%% compliance with the License. You should have received a copy of the
|
|
||||||
%% Erlang Public License along with this software. If not, it can be
|
|
||||||
%% retrieved via the world wide web at http://www.erlang.org/.
|
|
||||||
%%
|
|
||||||
%% Software distributed under the License is distributed on an "AS IS"
|
|
||||||
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
|
|
||||||
%% the License for the specific language governing rights and limitations
|
|
||||||
%% under the License.
|
|
||||||
%%
|
|
||||||
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
|
|
||||||
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
|
|
||||||
%% AB. All Rights Reserved.''
|
|
||||||
%%
|
|
||||||
%% $Id$
|
|
||||||
%%
|
|
||||||
%% This file is mostly copied from Erlang file_io_server.erl
|
|
||||||
%% See: http://www.erlang.org/ml-archive/erlang-questions/200607/msg00080.html
|
|
||||||
%% for details on ram_file_io_server.erl (Erlang OTP R11B-2)
|
|
||||||
-module(ram_file_io_server).
|
|
||||||
|
|
||||||
%% A simple file server for io to one file instance per server instance.
|
|
||||||
|
|
||||||
-export([format_error/1]).
|
|
||||||
-export([start/3, start_link/3]).
|
|
||||||
|
|
||||||
-record(state, {handle,owner,mref,buf,read_mode}).
|
|
||||||
|
|
||||||
-define(PRIM_FILE, ram_file).
|
|
||||||
-define(READ_SIZE_LIST, 128).
|
|
||||||
-define(READ_SIZE_BINARY, (8*1024)).
|
|
||||||
|
|
||||||
-define(eat_message(M, T), receive M -> M after T -> timeout end).
|
|
||||||
|
|
||||||
%%%-----------------------------------------------------------------
|
|
||||||
%%% Exported functions
|
|
||||||
|
|
||||||
format_error({_Line, ?MODULE, Reason}) ->
|
|
||||||
io_lib:format("~w", [Reason]);
|
|
||||||
format_error({_Line, Mod, Reason}) ->
|
|
||||||
Mod:format_error(Reason);
|
|
||||||
format_error(ErrorId) ->
|
|
||||||
erl_posix_msg:message(ErrorId).
|
|
||||||
|
|
||||||
start(Owner, FileName, ModeList)
|
|
||||||
when pid(Owner), list(FileName), list(ModeList) ->
|
|
||||||
do_start(spawn, Owner, FileName, ModeList).
|
|
||||||
|
|
||||||
start_link(Owner, FileName, ModeList)
|
|
||||||
when pid(Owner), list(FileName), list(ModeList) ->
|
|
||||||
do_start(spawn_link, Owner, FileName, ModeList).
|
|
||||||
|
|
||||||
%%%-----------------------------------------------------------------
|
|
||||||
%%% Server starter, dispatcher and helpers
|
|
||||||
|
|
||||||
do_start(Spawn, Owner, FileName, ModeList) ->
|
|
||||||
Self = self(),
|
|
||||||
Ref = make_ref(),
|
|
||||||
Pid =
|
|
||||||
erlang:Spawn(
|
|
||||||
fun() ->
|
|
||||||
%% process_flag(trap_exit, true),
|
|
||||||
{ReadMode,Opts} =
|
|
||||||
case lists:member(binary, ModeList) of
|
|
||||||
true ->
|
|
||||||
{binary,ModeList};
|
|
||||||
false ->
|
|
||||||
{list,[binary|ModeList]}
|
|
||||||
end,
|
|
||||||
case ?PRIM_FILE:open(FileName, Opts) of
|
|
||||||
{error, Reason} = Error ->
|
|
||||||
Self ! {Ref, Error},
|
|
||||||
exit(Reason);
|
|
||||||
{ok, Handle} ->
|
|
||||||
%% XXX must I handle R6 nodes here?
|
|
||||||
M = erlang:monitor(process, Owner),
|
|
||||||
Self ! {Ref, ok},
|
|
||||||
server_loop(
|
|
||||||
#state{handle = Handle,
|
|
||||||
owner = Owner,
|
|
||||||
mref = M,
|
|
||||||
buf = <<>>,
|
|
||||||
read_mode = ReadMode})
|
|
||||||
end
|
|
||||||
end),
|
|
||||||
Mref = erlang:monitor(process, Pid),
|
|
||||||
receive
|
|
||||||
{Ref, {error, _Reason} = Error} ->
|
|
||||||
erlang:demonitor(Mref),
|
|
||||||
receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end,
|
|
||||||
Error;
|
|
||||||
{Ref, ok} ->
|
|
||||||
erlang:demonitor(Mref),
|
|
||||||
receive
|
|
||||||
{'DOWN', Mref, _, _, Reason} ->
|
|
||||||
{error, Reason}
|
|
||||||
after 0 ->
|
|
||||||
{ok, Pid}
|
|
||||||
end;
|
|
||||||
{'DOWN', Mref, _, _, Reason} ->
|
|
||||||
{error, Reason}
|
|
||||||
end.
|
|
||||||
|
|
||||||
server_loop(#state{mref = Mref} = State) ->
|
|
||||||
receive
|
|
||||||
{file_request, From, ReplyAs, Request} when pid(From) ->
|
|
||||||
case file_request(Request, State) of
|
|
||||||
{reply, Reply, NewState} ->
|
|
||||||
file_reply(From, ReplyAs, Reply),
|
|
||||||
server_loop(NewState);
|
|
||||||
{error, Reply, NewState} ->
|
|
||||||
%% error is the same as reply, except that
|
|
||||||
%% it breaks the io_request_loop further down
|
|
||||||
file_reply(From, ReplyAs, Reply),
|
|
||||||
server_loop(NewState);
|
|
||||||
{stop, Reason, Reply, _NewState} ->
|
|
||||||
file_reply(From, ReplyAs, Reply),
|
|
||||||
exit(Reason)
|
|
||||||
end;
|
|
||||||
{io_request, From, ReplyAs, Request} when pid(From) ->
|
|
||||||
case io_request(Request, State) of
|
|
||||||
{reply, Reply, NewState} ->
|
|
||||||
io_reply(From, ReplyAs, Reply),
|
|
||||||
server_loop(NewState);
|
|
||||||
{error, Reply, NewState} ->
|
|
||||||
%% error is the same as reply, except that
|
|
||||||
%% it breaks the io_request_loop further down
|
|
||||||
io_reply(From, ReplyAs, Reply),
|
|
||||||
server_loop(NewState);
|
|
||||||
{stop, Reason, Reply, _NewState} ->
|
|
||||||
io_reply(From, ReplyAs, Reply),
|
|
||||||
exit(Reason)
|
|
||||||
end;
|
|
||||||
{'DOWN', Mref, _, _, Reason} ->
|
|
||||||
exit(Reason);
|
|
||||||
_ ->
|
|
||||||
server_loop(State)
|
|
||||||
end.
|
|
||||||
|
|
||||||
file_reply(From, ReplyAs, Reply) ->
|
|
||||||
From ! {file_reply, ReplyAs, Reply}.
|
|
||||||
|
|
||||||
io_reply(From, ReplyAs, Reply) ->
|
|
||||||
From ! {io_reply, ReplyAs, Reply}.
|
|
||||||
|
|
||||||
%%%-----------------------------------------------------------------
|
|
||||||
%%% file requests
|
|
||||||
|
|
||||||
file_request({pread,At,Sz},
|
|
||||||
#state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) ->
|
|
||||||
case position(Handle, At, Buf) of
|
|
||||||
{ok,_Offs} ->
|
|
||||||
case ?PRIM_FILE:read(Handle, Sz) of
|
|
||||||
{ok,Bin} when ReadMode==list ->
|
|
||||||
std_reply({ok,binary_to_list(Bin)}, State);
|
|
||||||
Reply ->
|
|
||||||
std_reply(Reply, State)
|
|
||||||
end;
|
|
||||||
Reply ->
|
|
||||||
std_reply(Reply, State)
|
|
||||||
end;
|
|
||||||
file_request({pwrite,At,Data},
|
|
||||||
#state{handle=Handle,buf=Buf}=State) ->
|
|
||||||
case position(Handle, At, Buf) of
|
|
||||||
{ok,_Offs} ->
|
|
||||||
std_reply(?PRIM_FILE:write(Handle, Data), State);
|
|
||||||
Reply ->
|
|
||||||
std_reply(Reply, State)
|
|
||||||
end;
|
|
||||||
file_request(sync,
|
|
||||||
#state{handle=Handle}=State) ->
|
|
||||||
case ?PRIM_FILE:sync(Handle) of
|
|
||||||
{error,_}=Reply ->
|
|
||||||
{stop,normal,Reply,State};
|
|
||||||
Reply ->
|
|
||||||
{reply,Reply,State}
|
|
||||||
end;
|
|
||||||
file_request(close,
|
|
||||||
#state{handle=Handle}=State) ->
|
|
||||||
{stop,normal,?PRIM_FILE:close(Handle),State#state{buf= <<>>}};
|
|
||||||
file_request({position,At},
|
|
||||||
#state{handle=Handle,buf=Buf}=State) ->
|
|
||||||
std_reply(position(Handle, At, Buf), State);
|
|
||||||
file_request(truncate,
|
|
||||||
#state{handle=Handle}=State) ->
|
|
||||||
case ?PRIM_FILE:truncate(Handle) of
|
|
||||||
{error,_Reason}=Reply ->
|
|
||||||
{stop,normal,Reply,State#state{buf= <<>>}};
|
|
||||||
Reply ->
|
|
||||||
{reply,Reply,State}
|
|
||||||
end;
|
|
||||||
file_request(Unknown,
|
|
||||||
#state{}=State) ->
|
|
||||||
Reason = {request, Unknown},
|
|
||||||
{error,{error,Reason},State}.
|
|
||||||
|
|
||||||
std_reply({error,_}=Reply, State) ->
|
|
||||||
{error,Reply,State#state{buf= <<>>}};
|
|
||||||
std_reply(Reply, State) ->
|
|
||||||
{reply,Reply,State#state{buf= <<>>}}.
|
|
||||||
|
|
||||||
%%%-----------------------------------------------------------------
|
|
||||||
%%% I/O request
|
|
||||||
|
|
||||||
io_request({put_chars,Chars}, % binary(Chars) new in R9C
|
|
||||||
#state{buf= <<>>}=State) ->
|
|
||||||
put_chars(Chars, State);
|
|
||||||
io_request({put_chars,Chars}, % binary(Chars) new in R9C
|
|
||||||
#state{handle=Handle,buf=Buf}=State) ->
|
|
||||||
case position(Handle, cur, Buf) of
|
|
||||||
{error,_}=Reply ->
|
|
||||||
{stop,normal,Reply,State#state{buf= <<>>}};
|
|
||||||
_ ->
|
|
||||||
put_chars(Chars, State#state{buf= <<>>})
|
|
||||||
end;
|
|
||||||
io_request({put_chars,Mod,Func,Args},
|
|
||||||
#state{}=State) ->
|
|
||||||
case catch apply(Mod, Func, Args) of
|
|
||||||
Chars when list(Chars); binary(Chars) ->
|
|
||||||
io_request({put_chars,Chars}, State);
|
|
||||||
_ ->
|
|
||||||
{error,{error,Func},State}
|
|
||||||
end;
|
|
||||||
io_request({get_until,_Prompt,Mod,Func,XtraArgs},
|
|
||||||
#state{}=State) ->
|
|
||||||
get_chars(io_lib, get_until, {Mod, Func, XtraArgs}, State);
|
|
||||||
io_request({get_chars,_Prompt,N}, % New in R9C
|
|
||||||
#state{}=State) ->
|
|
||||||
get_chars(N, State);
|
|
||||||
io_request({get_chars,_Prompt,Mod,Func,XtraArg}, % New in R9C
|
|
||||||
#state{}=State) ->
|
|
||||||
get_chars(Mod, Func, XtraArg, State);
|
|
||||||
io_request({get_line,_Prompt}, % New in R9C
|
|
||||||
#state{}=State) ->
|
|
||||||
get_chars(io_lib, collect_line, [], State);
|
|
||||||
io_request({setopts, Opts}, % New in R9C
|
|
||||||
#state{}=State) when list(Opts) ->
|
|
||||||
setopts(Opts, State);
|
|
||||||
io_request({requests,Requests},
|
|
||||||
#state{}=State) when list(Requests) ->
|
|
||||||
io_request_loop(Requests, {reply,ok,State});
|
|
||||||
io_request(Unknown,
|
|
||||||
#state{}=State) ->
|
|
||||||
Reason = {request,Unknown},
|
|
||||||
{error,{error,Reason},State}.
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
%% Process a list of requests as long as the results are ok.
|
|
||||||
|
|
||||||
io_request_loop([], Result) ->
|
|
||||||
Result;
|
|
||||||
io_request_loop([_Request|_Tail],
|
|
||||||
{stop,_Reason,_Reply,_State}=Result) ->
|
|
||||||
Result;
|
|
||||||
io_request_loop([_Request|_Tail],
|
|
||||||
{error,_Reply,_State}=Result) ->
|
|
||||||
Result;
|
|
||||||
io_request_loop([Request|Tail],
|
|
||||||
{reply,_Reply,State}) ->
|
|
||||||
io_request_loop(Tail, io_request(Request, State)).
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
%% I/O request put_chars
|
|
||||||
%%
|
|
||||||
put_chars(Chars, #state{handle=Handle}=State) ->
|
|
||||||
case ?PRIM_FILE:write(Handle, Chars) of
|
|
||||||
{error,_}=Reply ->
|
|
||||||
{stop,normal,Reply,State};
|
|
||||||
Reply ->
|
|
||||||
{reply,Reply,State}
|
|
||||||
end.
|
|
||||||
|
|
||||||
|
|
||||||
%% Process the I/O request get_chars
|
|
||||||
%%
|
|
||||||
get_chars(0, #state{read_mode=ReadMode}=State) ->
|
|
||||||
{reply,cast(<<>>, ReadMode),State};
|
|
||||||
get_chars(N, #state{buf=Buf,read_mode=ReadMode}=State)
|
|
||||||
when integer(N), N > 0, N =< size(Buf) ->
|
|
||||||
{B1,B2} = split_binary(Buf, N),
|
|
||||||
{reply,cast(B1, ReadMode),State#state{buf=B2}};
|
|
||||||
get_chars(N, #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State)
|
|
||||||
when integer(N), N > 0 ->
|
|
||||||
BufSize = size(Buf),
|
|
||||||
NeedSize = N-BufSize,
|
|
||||||
Size = max(NeedSize, ?READ_SIZE_BINARY),
|
|
||||||
case ?PRIM_FILE:read(Handle, Size) of
|
|
||||||
{ok, B} ->
|
|
||||||
if BufSize+size(B) < N ->
|
|
||||||
std_reply(cat(Buf, B, ReadMode), State);
|
|
||||||
true ->
|
|
||||||
{B1,B2} = split_binary(B, NeedSize),
|
|
||||||
{reply,cat(Buf, B1, ReadMode),State#state{buf=B2}}
|
|
||||||
end;
|
|
||||||
eof when BufSize==0 ->
|
|
||||||
{reply,eof,State};
|
|
||||||
eof ->
|
|
||||||
std_reply(cast(Buf, ReadMode), State);
|
|
||||||
{error,Reason}=Error ->
|
|
||||||
{stop,Reason,Error,State#state{buf= <<>>}}
|
|
||||||
end;
|
|
||||||
get_chars(_N, #state{}=State) ->
|
|
||||||
{error,{error,get_chars},State}.
|
|
||||||
|
|
||||||
get_chars(Mod, Func, XtraArg, #state{buf= <<>>}=State) ->
|
|
||||||
get_chars_empty(Mod, Func, XtraArg, start, State);
|
|
||||||
get_chars(Mod, Func, XtraArg, #state{buf=Buf}=State) ->
|
|
||||||
get_chars_apply(Mod, Func, XtraArg, start, State#state{buf= <<>>}, Buf).
|
|
||||||
|
|
||||||
get_chars_empty(Mod, Func, XtraArg, S,
|
|
||||||
#state{handle=Handle,read_mode=ReadMode}=State) ->
|
|
||||||
case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
|
|
||||||
{ok,Bin} ->
|
|
||||||
get_chars_apply(Mod, Func, XtraArg, S, State, Bin);
|
|
||||||
eof ->
|
|
||||||
get_chars_apply(Mod, Func, XtraArg, S, State, eof);
|
|
||||||
{error,Reason}=Error ->
|
|
||||||
{stop,Reason,Error,State}
|
|
||||||
end.
|
|
||||||
|
|
||||||
get_chars_apply(Mod, Func, XtraArg, S0,
|
|
||||||
#state{read_mode=ReadMode}=State, Data0) ->
|
|
||||||
Data1 = case ReadMode of
|
|
||||||
list when binary(Data0) -> binary_to_list(Data0);
|
|
||||||
_ -> Data0
|
|
||||||
end,
|
|
||||||
case catch Mod:Func(S0, Data1, XtraArg) of
|
|
||||||
{stop,Result,Buf} ->
|
|
||||||
{reply,Result,State#state{buf=cast_binary(Buf)}};
|
|
||||||
{'EXIT',Reason} ->
|
|
||||||
{stop,Reason,{error,err_func(Mod, Func, XtraArg)},State};
|
|
||||||
S1 ->
|
|
||||||
get_chars_empty(Mod, Func, XtraArg, S1, State)
|
|
||||||
end.
|
|
||||||
|
|
||||||
%% Convert error code to make it look as before
|
|
||||||
err_func(io_lib, get_until, {_,F,_}) ->
|
|
||||||
F;
|
|
||||||
err_func(_, F, _) ->
|
|
||||||
F.
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
%% Process the I/O request setopts
|
|
||||||
%%
|
|
||||||
%% setopts
|
|
||||||
setopts(Opts0, State) ->
|
|
||||||
Opts = proplists:substitute_negations([{list,binary}], Opts0),
|
|
||||||
case proplists:get_value(binary, Opts) of
|
|
||||||
true ->
|
|
||||||
{ok,ok,State#state{read_mode=binary}};
|
|
||||||
false ->
|
|
||||||
{ok,ok,State#state{read_mode=list}};
|
|
||||||
_ ->
|
|
||||||
{error,{error,badarg},State}
|
|
||||||
end.
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
%% Concatenate two binaries and convert the result to list or binary
|
|
||||||
cat(B1, B2, binary) ->
|
|
||||||
list_to_binary([B1,B2]);
|
|
||||||
cat(B1, B2, list) ->
|
|
||||||
binary_to_list(B1)++binary_to_list(B2).
|
|
||||||
|
|
||||||
%% Cast binary to list or binary
|
|
||||||
cast(B, binary) ->
|
|
||||||
B;
|
|
||||||
cast(B, list) ->
|
|
||||||
binary_to_list(B).
|
|
||||||
|
|
||||||
%% Convert buffer to binary
|
|
||||||
cast_binary(Binary) when binary(Binary) ->
|
|
||||||
Binary;
|
|
||||||
cast_binary(List) when list(List) ->
|
|
||||||
list_to_binary(List);
|
|
||||||
cast_binary(_EOF) ->
|
|
||||||
<<>>.
|
|
||||||
|
|
||||||
%% Read size for different read modes
|
|
||||||
read_size(binary) ->
|
|
||||||
?READ_SIZE_BINARY;
|
|
||||||
read_size(list) ->
|
|
||||||
?READ_SIZE_LIST.
|
|
||||||
|
|
||||||
max(A, B) when A >= B ->
|
|
||||||
A;
|
|
||||||
max(_, B) ->
|
|
||||||
B.
|
|
||||||
|
|
||||||
%%%-----------------------------------------------------------------
|
|
||||||
%%% ?PRIM_FILE helpers
|
|
||||||
|
|
||||||
%% Compensates ?PRIM_FILE:position/2 for the number of bytes
|
|
||||||
%% we have buffered
|
|
||||||
|
|
||||||
position(Handle, cur, Buf) ->
|
|
||||||
position(Handle, {cur, 0}, Buf);
|
|
||||||
position(Handle, {cur, Offs}, Buf) when list(Buf) ->
|
|
||||||
?PRIM_FILE:position(Handle, {cur, Offs-length(Buf)});
|
|
||||||
position(Handle, {cur, Offs}, Buf) when binary(Buf) ->
|
|
||||||
?PRIM_FILE:position(Handle, {cur, Offs-size(Buf)});
|
|
||||||
position(Handle, At, _Buf) ->
|
|
||||||
?PRIM_FILE:position(Handle, At).
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user