Skip to content
This repository
Browse code

* 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
  • Loading branch information...
commit dff6e28b2daca542c38b5f139b00aaea413d810a 1 parent 9b37078
badlop badlop authored
11 ChangeLog
... ... @@ -1,3 +1,14 @@
  1 +2009-05-06 Badlop <badlop@process-one.net>
  2 +
  3 + * src/ejabberd_loglevel.erl: Use dynamic_compile instead of
  4 + ram_file_io_server. Support definition of loglevels with integer
  5 + or atom. (thanks to Geoff Cant)(EJAB-919)
  6 + * src/dynamic_compile.erl: Added erlang module that converts
  7 + string to binary loadable code by Mats Cronqvist, Chris Newcombe,
  8 + and Jacob Vorreuter.
  9 + * src/ram_file_io_server.erl: Remove file not longer useful.
  10 + * src/ejabberd.app: Likewise
  11 +
1 12 2009-05-03 Badlop <badlop@process-one.net>
2 13
3 14 * src/mod_muc/mod_muc_room.erl: Fix badarg return (EJAB-899)
268 src/dynamic_compile.erl
... ... @@ -0,0 +1,268 @@
  1 +%% Copyright (c) 2007
  2 +%% Mats Cronqvist <mats.cronqvist@ericsson.com>
  3 +%% Chris Newcombe <chris.newcombe@gmail.com>
  4 +%% Jacob Vorreuter <jacob.vorreuter@gmail.com>
  5 +%%
  6 +%% Permission is hereby granted, free of charge, to any person
  7 +%% obtaining a copy of this software and associated documentation
  8 +%% files (the "Software"), to deal in the Software without
  9 +%% restriction, including without limitation the rights to use,
  10 +%% copy, modify, merge, publish, distribute, sublicense, and/or sell
  11 +%% copies of the Software, and to permit persons to whom the
  12 +%% Software is furnished to do so, subject to the following
  13 +%% conditions:
  14 +%%
  15 +%% The above copyright notice and this permission notice shall be
  16 +%% included in all copies or substantial portions of the Software.
  17 +%%
  18 +%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 +%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  20 +%% OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 +%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  22 +%% HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  23 +%% WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  24 +%% FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  25 +%% OTHER DEALINGS IN THE SOFTWARE.
  26 +
  27 +%%%-------------------------------------------------------------------
  28 +%%% File : dynamic_compile.erl
  29 +%%% Description :
  30 +%%% Authors : Mats Cronqvist <mats.cronqvist@ericsson.com>
  31 +%%% Chris Newcombe <chris.newcombe@gmail.com>
  32 +%%% Jacob Vorreuter <jacob.vorreuter@gmail.com>
  33 +%%% TODO :
  34 +%%% - add support for limit include-file depth (and prevent circular references)
  35 +%%% prevent circular macro expansion set FILE correctly when -module() is found
  36 +%%% -include_lib support $ENVVAR in include filenames
  37 +%%% substitute-stringize (??MACRO)
  38 +%%% -undef/-ifdef/-ifndef/-else/-endif
  39 +%%% -file(File, Line)
  40 +%%%-------------------------------------------------------------------
  41 +-module(dynamic_compile).
  42 +
  43 +%% API
  44 +-export([from_string/1, from_string/2]).
  45 +
  46 +-import(lists, [reverse/1, keyreplace/4]).
  47 +
  48 +%%====================================================================
  49 +%% API
  50 +%%====================================================================
  51 +%%--------------------------------------------------------------------
  52 +%% Function:
  53 +%% Description:
  54 +%% Returns a binary that can be used with
  55 +%% code:load_binary(Module, ModuleFilenameForInternalRecords, Binary).
  56 +%%--------------------------------------------------------------------
  57 +from_string(CodeStr) ->
  58 + from_string(CodeStr, []).
  59 +
  60 +% takes Options as for compile:forms/2
  61 +from_string(CodeStr, CompileFormsOptions) ->
  62 + %% Initialise the macro dictionary with the default predefined macros,
  63 + %% (adapted from epp.erl:predef_macros/1
  64 + Filename = "compiled_from_string",
  65 + %%Machine = list_to_atom(erlang:system_info(machine)),
  66 + Ms0 = dict:new(),
  67 + % Ms1 = dict:store('FILE', {[], "compiled_from_string"}, Ms0),
  68 + % Ms2 = dict:store('LINE', {[], 1}, Ms1), % actually we might add special code for this
  69 + % Ms3 = dict:store('MODULE', {[], undefined}, Ms2),
  70 + % Ms4 = dict:store('MODULE_STRING', {[], undefined}, Ms3),
  71 + % Ms5 = dict:store('MACHINE', {[], Machine}, Ms4),
  72 + % InitMD = dict:store(Machine, {[], true}, Ms5),
  73 + InitMD = Ms0,
  74 +
  75 + %% From the docs for compile:forms:
  76 + %% When encountering an -include or -include_dir directive, the compiler searches for header files in the following directories:
  77 + %% 1. ".", the current working directory of the file server;
  78 + %% 2. the base name of the compiled file;
  79 + %% 3. the directories specified using the i option. The directory specified last is searched first.
  80 + %% In this case, #2 is meaningless.
  81 + IncludeSearchPath = ["." | reverse([Dir || {i, Dir} <- CompileFormsOptions])],
  82 + {RevForms, _OutMacroDict} = scan_and_parse(CodeStr, Filename, 1, [], InitMD, IncludeSearchPath),
  83 + Forms = reverse(RevForms),
  84 +
  85 + %% note: 'binary' is forced as an implicit option, whether it is provided or not.
  86 + case compile:forms(Forms, CompileFormsOptions) of
  87 + {ok, ModuleName, CompiledCodeBinary} when is_binary(CompiledCodeBinary) ->
  88 + {ModuleName, CompiledCodeBinary};
  89 + {ok, ModuleName, CompiledCodeBinary, []} when is_binary(CompiledCodeBinary) -> % empty warnings list
  90 + {ModuleName, CompiledCodeBinary};
  91 + {ok, _ModuleName, _CompiledCodeBinary, Warnings} ->
  92 + throw({?MODULE, warnings, Warnings});
  93 + Other ->
  94 + throw({?MODULE, compile_forms, Other})
  95 + end.
  96 +
  97 +%%====================================================================
  98 +%% Internal functions
  99 +%%====================================================================
  100 +%%% Code from Mats Cronqvist
  101 +%%% See http://www.erlang.org/pipermail/erlang-questions/2007-March/025507.html
  102 +%%%## 'scan_and_parse'
  103 +%%%
  104 +%%% basically we call the OTP scanner and parser (erl_scan and
  105 +%%% erl_parse) line-by-line, but check each scanned line for (or
  106 +%%% definitions of) macros before parsing.
  107 +%% returns {ReverseForms, FinalMacroDict}
  108 +scan_and_parse([], _CurrFilename, _CurrLine, RevForms, MacroDict, _IncludeSearchPath) ->
  109 + {RevForms, MacroDict};
  110 +
  111 +scan_and_parse(RemainingText, CurrFilename, CurrLine, RevForms, MacroDict, IncludeSearchPath) ->
  112 + case scanner(RemainingText, CurrLine, MacroDict) of
  113 + {tokens, NLine, NRemainingText, Toks} ->
  114 + {ok, Form} = erl_parse:parse_form(Toks),
  115 + scan_and_parse(NRemainingText, CurrFilename, NLine, [Form | RevForms], MacroDict, IncludeSearchPath);
  116 + {macro, NLine, NRemainingText, NMacroDict} ->
  117 + scan_and_parse(NRemainingText, CurrFilename, NLine, RevForms,NMacroDict, IncludeSearchPath);
  118 + {include, NLine, NRemainingText, IncludeFilename} ->
  119 + IncludeFileRemainingTextents = read_include_file(IncludeFilename, IncludeSearchPath),
  120 + %%io:format("include file ~p contents: ~n~p~nRemainingText = ~p~n", [IncludeFilename,IncludeFileRemainingTextents, RemainingText]),
  121 + %% Modify the FILE macro to reflect the filename
  122 + %%IncludeMacroDict = dict:store('FILE', {[],IncludeFilename}, MacroDict),
  123 + IncludeMacroDict = MacroDict,
  124 +
  125 + %% Process the header file (inc. any nested header files)
  126 + {RevIncludeForms, IncludedMacroDict} = scan_and_parse(IncludeFileRemainingTextents, IncludeFilename, 1, [], IncludeMacroDict, IncludeSearchPath),
  127 + %io:format("include file results = ~p~n", [R]),
  128 + %% Restore the FILE macro in the NEW MacroDict (so we keep any macros defined in the header file)
  129 + %%NMacroDict = dict:store('FILE', {[],CurrFilename}, IncludedMacroDict),
  130 + NMacroDict = IncludedMacroDict,
  131 +
  132 + %% Continue with the original file
  133 + scan_and_parse(NRemainingText, CurrFilename, NLine, RevIncludeForms ++ RevForms, NMacroDict, IncludeSearchPath);
  134 + done ->
  135 + scan_and_parse([], CurrFilename, CurrLine, RevForms, MacroDict, IncludeSearchPath)
  136 + end.
  137 +
  138 +scanner(Text, Line, MacroDict) ->
  139 + case erl_scan:tokens([],Text,Line) of
  140 + {done, {ok,Toks,NLine}, LeftOverChars} ->
  141 + case pre_proc(Toks, MacroDict) of
  142 + {tokens, NToks} -> {tokens, NLine, LeftOverChars, NToks};
  143 + {macro, NMacroDict} -> {macro, NLine, LeftOverChars, NMacroDict};
  144 + {include, Filename} -> {include, NLine, LeftOverChars, Filename}
  145 + end;
  146 + {more, _Continuation} ->
  147 + %% This is supposed to mean "term is not yet complete" (i.e. a '.' has
  148 + %% not been reached yet).
  149 + %% However, for some bizarre reason we also get this if there is a comment after the final '.' in a file.
  150 + %% So we check to see if Text only consists of comments.
  151 + case is_only_comments(Text) of
  152 + true ->
  153 + done;
  154 + false ->
  155 + throw({incomplete_term, Text, Line})
  156 + end
  157 + end.
  158 +
  159 +is_only_comments(Text) -> is_only_comments(Text, not_in_comment).
  160 +
  161 +is_only_comments([], _) -> true;
  162 +is_only_comments([$ |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
  163 +is_only_comments([$\t |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
  164 +is_only_comments([$\n |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
  165 +is_only_comments([$% |T], not_in_comment) -> is_only_comments(T, in_comment); % found start of a comment
  166 +is_only_comments(_, not_in_comment) -> false;
  167 +% found any significant char NOT in a comment
  168 +is_only_comments([$\n |T], in_comment) -> is_only_comments(T, not_in_comment); % found end of a comment
  169 +is_only_comments([_ |T], in_comment) -> is_only_comments(T, in_comment). % skipping over in-comment chars
  170 +
  171 +%%%## 'pre-proc'
  172 +%%%
  173 +%%% have to implement a subset of the pre-processor, since epp insists
  174 +%%% on running on a file.
  175 +%%% only handles 2 cases;
  176 +%% -define(MACRO, something).
  177 +%% -define(MACRO(VAR1,VARN),{stuff,VAR1,more,stuff,VARN,extra,stuff}).
  178 +pre_proc([{'-',_},{atom,_,define},{'(',_},{_,_,Name}|DefToks],MacroDict) ->
  179 + false = dict:is_key(Name, MacroDict),
  180 + case DefToks of
  181 + [{',',_} | Macro] ->
  182 + {macro, dict:store(Name, {[], macro_body_def(Macro, [])}, MacroDict)};
  183 + [{'(',_} | Macro] ->
  184 + {macro, dict:store(Name, macro_params_body_def(Macro, []), MacroDict)}
  185 + end;
  186 +
  187 +pre_proc([{'-',_}, {atom,_,include}, {'(',_}, {string,_,Filename}, {')',_}, {dot,_}], _MacroDict) ->
  188 + {include, Filename};
  189 +
  190 +pre_proc(Toks,MacroDict) ->
  191 + {tokens, subst_macros(Toks, MacroDict)}.
  192 +
  193 +macro_params_body_def([{')',_},{',',_} | Toks], RevParams) ->
  194 + {reverse(RevParams), macro_body_def(Toks, [])};
  195 +macro_params_body_def([{var,_,Param} | Toks], RevParams) ->
  196 + macro_params_body_def(Toks, [Param | RevParams]);
  197 +macro_params_body_def([{',',_}, {var,_,Param} | Toks], RevParams) ->
  198 + macro_params_body_def(Toks, [Param | RevParams]).
  199 +
  200 +macro_body_def([{')',_}, {dot,_}], RevMacroBodyToks) ->
  201 + reverse(RevMacroBodyToks);
  202 +macro_body_def([Tok|Toks], RevMacroBodyToks) ->
  203 + macro_body_def(Toks, [Tok | RevMacroBodyToks]).
  204 +
  205 +subst_macros(Toks, MacroDict) ->
  206 + reverse(subst_macros_rev(Toks, MacroDict, [])).
  207 +
  208 +%% returns a reversed list of tokes
  209 +subst_macros_rev([{'?',_}, {_,LineNum,'LINE'} | Toks], MacroDict, RevOutToks) ->
  210 + %% special-case for ?LINE, to avoid creating a new MacroDict for every line in the source file
  211 + subst_macros_rev(Toks, MacroDict, [{integer,LineNum,LineNum}] ++ RevOutToks);
  212 +
  213 +subst_macros_rev([{'?',_}, {_,_,Name}, {'(',_} = Paren | Toks], MacroDict, RevOutToks) ->
  214 + case dict:fetch(Name, MacroDict) of
  215 + {[], MacroValue} ->
  216 + %% This macro does not have any vars, so ignore the fact that the invocation is followed by "(...stuff"
  217 + %% Recursively expand any macro calls inside this macro's value
  218 + %% TODO: avoid infinite expansion due to circular references (even indirect ones)
  219 + RevExpandedOtherMacrosToks = subst_macros_rev(MacroValue, MacroDict, []),
  220 + subst_macros_rev([Paren|Toks], MacroDict, RevExpandedOtherMacrosToks ++ RevOutToks);
  221 + ParamsAndBody ->
  222 + %% This macro does have vars.
  223 + %% Collect all of the passe arguments, in an ordered list
  224 + {NToks, Arguments} = subst_macros_get_args(Toks, []),
  225 + %% Expand the varibles
  226 + ExpandedParamsToks = subst_macros_subst_args_for_vars(ParamsAndBody, Arguments),
  227 + %% Recursively expand any macro calls inside this macro's value
  228 + %% TODO: avoid infinite expansion due to circular references (even indirect ones)
  229 + RevExpandedOtherMacrosToks = subst_macros_rev(ExpandedParamsToks, MacroDict, []),
  230 + subst_macros_rev(NToks, MacroDict, RevExpandedOtherMacrosToks ++ RevOutToks)
  231 + end;
  232 +
  233 +subst_macros_rev([{'?',_}, {_,_,Name} | Toks], MacroDict, RevOutToks) ->
  234 + %% This macro invocation does not have arguments.
  235 + %% Therefore the definition should not have parameters
  236 + {[], MacroValue} = dict:fetch(Name, MacroDict),
  237 +
  238 + %% Recursively expand any macro calls inside this macro's value
  239 + %% TODO: avoid infinite expansion due to circular references (even indirect ones)
  240 + RevExpandedOtherMacrosToks = subst_macros_rev(MacroValue, MacroDict, []),
  241 + subst_macros_rev(Toks, MacroDict, RevExpandedOtherMacrosToks ++ RevOutToks);
  242 +
  243 +subst_macros_rev([Tok|Toks], MacroDict, RevOutToks) ->
  244 +subst_macros_rev(Toks, MacroDict, [Tok|RevOutToks]);
  245 +subst_macros_rev([], _MacroDict, RevOutToks) -> RevOutToks.
  246 +
  247 +subst_macros_get_args([{')',_} | Toks], RevArgs) ->
  248 + {Toks, reverse(RevArgs)};
  249 +subst_macros_get_args([{',',_}, {var,_,ArgName} | Toks], RevArgs) ->
  250 + subst_macros_get_args(Toks, [ArgName| RevArgs]);
  251 +subst_macros_get_args([{var,_,ArgName} | Toks], RevArgs) ->
  252 + subst_macros_get_args(Toks, [ArgName | RevArgs]).
  253 +
  254 +subst_macros_subst_args_for_vars({[], BodyToks}, []) ->
  255 + BodyToks;
  256 +subst_macros_subst_args_for_vars({[Param | Params], BodyToks}, [Arg|Args]) ->
  257 + NBodyToks = keyreplace(Param, 3, BodyToks, {var,1,Arg}),
  258 + subst_macros_subst_args_for_vars({Params, NBodyToks}, Args).
  259 +
  260 +read_include_file(Filename, IncludeSearchPath) ->
  261 + case file:path_open(IncludeSearchPath, Filename, [read, raw, binary]) of
  262 + {ok, IoDevice, FullName} ->
  263 + {ok, Data} = file:read(IoDevice, filelib:file_size(FullName)),
  264 + file:close(IoDevice),
  265 + binary_to_list(Data);
  266 + {error, Reason} ->
  267 + throw({failed_to_read_include_file, Reason, Filename, IncludeSearchPath})
  268 + end.
1  src/ejabberd.app
@@ -115,7 +115,6 @@
115 115 nodetree_virtual,
116 116 p1_fsm,
117 117 p1_mnesia,
118   - ram_file_io_server,
119 118 randoms,
120 119 sha,
121 120 shaper,
61 src/ejabberd_loglevel.erl
@@ -38,51 +38,30 @@
38 38 -define(LOGMODULE, "error_logger").
39 39
40 40 %% Error levels:
41   -%% 0 -> No log
42   -%% 1 -> Critical
43   -%% 2 -> Error
44   -%% 3 -> Warning
45   -%% 4 -> Info
46   -%% 5 -> Debug
  41 +-define(LOG_LEVELS,[ {0, no_log, "No log"}
  42 + ,{1, critical, "Critical"}
  43 + ,{2, error, "Error"}
  44 + ,{3, warning, "Warning"}
  45 + ,{4, info, "Info"}
  46 + ,{5, debug, "Debug"}
  47 + ]).
  48 +
  49 +set(LogLevel) when is_atom(LogLevel) ->
  50 + set(level_to_integer(LogLevel));
47 51 set(Loglevel) when is_integer(Loglevel) ->
48   - Forms = compile_string(?LOGMODULE, ejabberd_logger_src(Loglevel)),
49   - load_logger(Forms, ?LOGMODULE, Loglevel);
  52 + try
  53 + {Mod,Code} = dynamic_compile:from_string(ejabberd_logger_src(Loglevel)),
  54 + code:load_binary(Mod, ?LOGMODULE ++ ".erl", Code)
  55 + catch
  56 + Type:Error -> ?CRITICAL_MSG("Error compiling logger (~p): ~p~n", [Type, Error])
  57 + end;
50 58 set(_) ->
51 59 exit("Loglevel must be an integer").
52   -
53   -%% --------------------------------------------------------------
54   -%% Compile a string into a module and returns the binary
55   -compile_string(Mod, Str) ->
56   - Fname = Mod ++ ".erl",
57   - {ok, Fd} = open_ram_file(Fname),
58   - file:write(Fd, Str),
59   - file:position(Fd, 0),
60   - case epp_dodger:parse(Fd) of
61   - {ok, Tree} ->
62   - Forms = revert_tree(Tree),
63   - close_ram_file(Fd),
64   - Forms;
65   - Error ->
66   - close_ram_file(Fd),
67   - Error
68   - end.
69   -
70   -open_ram_file(Fname) ->
71   - ram_file_io_server:start(self(), Fname, [read,write]).
72   -
73   -close_ram_file(Fd) ->
74   - file:close(Fd).
75   -
76   -revert_tree(Tree) ->
77   - [erl_syntax:revert(T) || T <- Tree].
78 60
79   -load_logger(Forms, Mod, Loglevel) ->
80   - Fname = Mod ++ ".erl",
81   - case compile:forms(Forms, [binary, {d,'LOGLEVEL',Loglevel}]) of
82   - {ok, M, Bin} ->
83   - code:load_binary(M, Fname, Bin);
84   - Error ->
85   - ?CRITICAL_MSG("Error ~p~n", [Error])
  61 +level_to_integer(Level) ->
  62 + case lists:keyfind(Level, 2, ?LOG_LEVELS) of
  63 + {Int, Level, _Desc} -> Int;
  64 + _ -> erlang:error({no_such_loglevel, Level})
86 65 end.
87 66
88 67 %% --------------------------------------------------------------
408 src/ram_file_io_server.erl
... ... @@ -1,408 +0,0 @@
1   -%% ``The contents of this file are subject to the Erlang Public License,
2   -%% Version 1.1, (the "License"); you may not use this file except in
3   -%% compliance with the License. You should have received a copy of the
4   -%% Erlang Public License along with this software. If not, it can be
5   -%% retrieved via the world wide web at http://www.erlang.org/.
6   -%%
7   -%% Software distributed under the License is distributed on an "AS IS"
8   -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
9   -%% the License for the specific language governing rights and limitations
10   -%% under the License.
11   -%%
12   -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
13   -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
14   -%% AB. All Rights Reserved.''
15   -%%
16   -%% $Id$
17   -%%
18   -%% This file is mostly copied from Erlang file_io_server.erl
19   -%% See: http://www.erlang.org/ml-archive/erlang-questions/200607/msg00080.html
20   -%% for details on ram_file_io_server.erl (Erlang OTP R11B-2)
21   --module(ram_file_io_server).
22   -
23   -%% A simple file server for io to one file instance per server instance.
24   -
25   --export([format_error/1]).
26   --export([start/3, start_link/3]).
27   -
28   --record(state, {handle,owner,mref,buf,read_mode}).
29   -
30   --define(PRIM_FILE, ram_file).
31   --define(READ_SIZE_LIST, 128).
32   --define(READ_SIZE_BINARY, (8*1024)).
33   -
34   --define(eat_message(M, T), receive M -> M after T -> timeout end).
35   -
36   -%%%-----------------------------------------------------------------
37   -%%% Exported functions
38   -
39   -format_error({_Line, ?MODULE, Reason}) ->
40   - io_lib:format("~w", [Reason]);
41   -format_error({_Line, Mod, Reason}) ->
42   - Mod:format_error(Reason);
43   -format_error(ErrorId) ->
44   - erl_posix_msg:message(ErrorId).
45   -
46   -start(Owner, FileName, ModeList)
47   - when pid(Owner), list(FileName), list(ModeList) ->
48   - do_start(spawn, Owner, FileName, ModeList).
49   -
50   -start_link(Owner, FileName, ModeList)
51   - when pid(Owner), list(FileName), list(ModeList) ->
52   - do_start(spawn_link, Owner, FileName, ModeList).
53   -
54   -%%%-----------------------------------------------------------------
55   -%%% Server starter, dispatcher and helpers
56   -
57   -do_start(Spawn, Owner, FileName, ModeList) ->
58   - Self = self(),
59   - Ref = make_ref(),
60   - Pid =
61   - erlang:Spawn(
62   - fun() ->
63   - %% process_flag(trap_exit, true),
64   - {ReadMode,Opts} =
65   - case lists:member(binary, ModeList) of
66   - true ->
67   - {binary,ModeList};
68   - false ->
69   - {list,[binary|ModeList]}
70   - end,
71   - case ?PRIM_FILE:open(FileName, Opts) of
72   - {error, Reason} = Error ->
73   - Self ! {Ref, Error},
74   - exit(Reason);
75   - {ok, Handle} ->
76   - %% XXX must I handle R6 nodes here?
77   - M = erlang:monitor(process, Owner),
78   - Self ! {Ref, ok},
79   - server_loop(
80   - #state{handle = Handle,
81   - owner = Owner,
82   - mref = M,
83   - buf = <<>>,
84   - read_mode = ReadMode})
85   - end
86   - end),
87   - Mref = erlang:monitor(process, Pid),
88   - receive
89   - {Ref, {error, _Reason} = Error} ->
90   - erlang:demonitor(Mref),
91   - receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end,
92   - Error;
93   - {Ref, ok} ->
94   - erlang:demonitor(Mref),
95   - receive
96   - {'DOWN', Mref, _, _, Reason} ->
97   - {error, Reason}
98   - after 0 ->
99   - {ok, Pid}
100   - end;
101   - {'DOWN', Mref, _, _, Reason} ->
102   - {error, Reason}
103   - end.
104   -
105   -server_loop(#state{mref = Mref} = State) ->
106   - receive
107   - {file_request, From, ReplyAs, Request} when pid(From) ->
108   - case file_request(Request, State) of
109   - {reply, Reply, NewState} ->
110   - file_reply(From, ReplyAs, Reply),
111   - server_loop(NewState);
112   - {error, Reply, NewState} ->
113   - %% error is the same as reply, except that
114   - %% it breaks the io_request_loop further down
115   - file_reply(From, ReplyAs, Reply),
116   - server_loop(NewState);
117   - {stop, Reason, Reply, _NewState} ->
118   - file_reply(From, ReplyAs, Reply),
119   - exit(Reason)
120   - end;
121   - {io_request, From, ReplyAs, Request} when pid(From) ->
122   - case io_request(Request, State) of
123   - {reply, Reply, NewState} ->
124   - io_reply(From, ReplyAs, Reply),
125   - server_loop(NewState);
126   - {error, Reply, NewState} ->
127   - %% error is the same as reply, except that
128   - %% it breaks the io_request_loop further down
129   - io_reply(From, ReplyAs, Reply),
130   - server_loop(NewState);
131   - {stop, Reason, Reply, _NewState} ->
132   - io_reply(From, ReplyAs, Reply),
133   - exit(Reason)
134   - end;
135   - {'DOWN', Mref, _, _, Reason} ->
136   - exit(Reason);
137   - _ ->
138   - server_loop(State)
139   - end.
140   -
141   -file_reply(From, ReplyAs, Reply) ->
142   - From ! {file_reply, ReplyAs, Reply}.
143   -
144   -io_reply(From, ReplyAs, Reply) ->
145   - From ! {io_reply, ReplyAs, Reply}.
146   -
147   -%%%-----------------------------------------------------------------
148   -%%% file requests
149   -
150   -file_request({pread,At,Sz},
151   - #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) ->
152   - case position(Handle, At, Buf) of
153   - {ok,_Offs} ->
154   - case ?PRIM_FILE:read(Handle, Sz) of
155   - {ok,Bin} when ReadMode==list ->
156   - std_reply({ok,binary_to_list(Bin)}, State);
157   - Reply ->
158   - std_reply(Reply, State)
159   - end;
160   - Reply ->
161   - std_reply(Reply, State)
162   - end;
163   -file_request({pwrite,At,Data},
164   - #state{handle=Handle,buf=Buf}=State) ->
165   - case position(Handle, At, Buf) of
166   - {ok,_Offs} ->
167   - std_reply(?PRIM_FILE:write(Handle, Data), State);
168   - Reply ->
169   - std_reply(Reply, State)
170   - end;
171   -file_request(sync,
172   - #state{handle=Handle}=State) ->
173   - case ?PRIM_FILE:sync(Handle) of
174   - {error,_}=Reply ->
175   - {stop,normal,Reply,State};
176   - Reply ->
177   - {reply,Reply,State}
178   - end;
179   -file_request(close,
180   - #state{handle=Handle}=State) ->
181   - {stop,normal,?PRIM_FILE:close(Handle),State#state{buf= <<>>}};
182   -file_request({position,At},
183   - #state{handle=Handle,buf=Buf}=State) ->
184   - std_reply(position(Handle, At, Buf), State);
185   -file_request(truncate,
186   - #state{handle=Handle}=State) ->
187   - case ?PRIM_FILE:truncate(Handle) of
188   - {error,_Reason}=Reply ->
189   - {stop,normal,Reply,State#state{buf= <<>>}};
190   - Reply ->
191   - {reply,Reply,State}
192   - end;
193   -file_request(Unknown,
194   - #state{}=State) ->
195   - Reason = {request, Unknown},
196   - {error,{error,Reason},State}.
197   -
198   -std_reply({error,_}=Reply, State) ->
199   - {error,Reply,State#state{buf= <<>>}};
200   -std_reply(Reply, State) ->
201   - {reply,Reply,State#state{buf= <<>>}}.
202   -
203   -%%%-----------------------------------------------------------------
204   -%%% I/O request
205   -
206   -io_request({put_chars,Chars}, % binary(Chars) new in R9C
207   - #state{buf= <<>>}=State) ->
208   - put_chars(Chars, State);
209   -io_request({put_chars,Chars}, % binary(Chars) new in R9C
210   - #state{handle=Handle,buf=Buf}=State) ->
211   - case position(Handle, cur, Buf) of
212   - {error,_}=Reply ->
213   - {stop,normal,Reply,State#state{buf= <<>>}};
214   - _ ->
215   - put_chars(Chars, State#state{buf= <<>>})
216   - end;
217   -io_request({put_chars,Mod,Func,Args},
218   - #state{}=State) ->
219   - case catch apply(Mod, Func, Args) of
220   - Chars when list(Chars); binary(Chars) ->
221   - io_request({put_chars,Chars}, State);
222   - _ ->
223   - {error,{error,Func},State}
224   - end;
225   -io_request({get_until,_Prompt,Mod,Func,XtraArgs},
226   - #state{}=State) ->
227   - get_chars(io_lib, get_until, {Mod, Func, XtraArgs}, State);
228   -io_request({get_chars,_Prompt,N}, % New in R9C
229   - #state{}=State) ->
230   - get_chars(N, State);
231   -io_request({get_chars,_Prompt,Mod,Func,XtraArg}, % New in R9C
232   - #state{}=State) ->
233   - get_chars(Mod, Func, XtraArg, State);
234   -io_request({get_line,_Prompt}, % New in R9C
235   - #state{}=State) ->
236   - get_chars(io_lib, collect_line, [], State);
237   -io_request({setopts, Opts}, % New in R9C
238   - #state{}=State) when list(Opts) ->
239   - setopts(Opts, State);
240   -io_request({requests,Requests},
241   - #state{}=State) when list(Requests) ->
242   - io_request_loop(Requests, {reply,ok,State});
243   -io_request(Unknown,
244   - #state{}=State) ->
245   - Reason = {request,Unknown},
246   - {error,{error,Reason},State}.
247   -
248   -
249   -
250   -%% Process a list of requests as long as the results are ok.
251   -
252   -io_request_loop([], Result) ->
253   - Result;
254   -io_request_loop([_Request|_Tail],
255   - {stop,_Reason,_Reply,_State}=Result) ->
256   - Result;
257   -io_request_loop([_Request|_Tail],
258   - {error,_Reply,_State}=Result) ->
259   - Result;
260   -io_request_loop([Request|Tail],
261   - {reply,_Reply,State}) ->
262   - io_request_loop(Tail, io_request(Request, State)).
263   -
264   -
265   -
266   -%% I/O request put_chars
267   -%%
268   -put_chars(Chars, #state{handle=Handle}=State) ->
269   - case ?PRIM_FILE:write(Handle, Chars) of
270   - {error,_}=Reply ->
271   - {stop,normal,Reply,State};
272   - Reply ->
273   - {reply,Reply,State}
274   - end.
275   -
276   -
277   -%% Process the I/O request get_chars
278   -%%
279   -get_chars(0, #state{read_mode=ReadMode}=State) ->
280   - {reply,cast(<<>>, ReadMode),State};
281   -get_chars(N, #state{buf=Buf,read_mode=ReadMode}=State)
282   - when integer(N), N > 0, N =< size(Buf) ->
283   - {B1,B2} = split_binary(Buf, N),
284   - {reply,cast(B1, ReadMode),State#state{buf=B2}};
285   -get_chars(N, #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State)
286   - when integer(N), N > 0 ->
287   - BufSize = size(Buf),
288   - NeedSize = N-BufSize,
289   - Size = max(NeedSize, ?READ_SIZE_BINARY),
290   - case ?PRIM_FILE:read(Handle, Size) of
291   - {ok, B} ->
292   - if BufSize+size(B) < N ->
293   - std_reply(cat(Buf, B, ReadMode), State);
294   - true ->
295   - {B1,B2} = split_binary(B, NeedSize),
296   - {reply,cat(Buf, B1, ReadMode),State#state{buf=B2}}
297   - end;
298   - eof when BufSize==0 ->
299   - {reply,eof,State};
300   - eof ->
301   - std_reply(cast(Buf, ReadMode), State);
302   - {error,Reason}=Error ->
303   - {stop,Reason,Error,State#state{buf= <<>>}}
304   - end;
305   -get_chars(_N, #state{}=State) ->
306   - {error,{error,get_chars},State}.
307   -
308   -get_chars(Mod, Func, XtraArg, #state{buf= <<>>}=State) ->
309   - get_chars_empty(Mod, Func, XtraArg, start, State);
310   -get_chars(Mod, Func, XtraArg, #state{buf=Buf}=State) ->
311   - get_chars_apply(Mod, Func, XtraArg, start, State#state{buf= <<>>}, Buf).
312   -
313   -get_chars_empty(Mod, Func, XtraArg, S,
314   - #state{handle=Handle,read_mode=ReadMode}=State) ->
315   - case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
316   - {ok,Bin} ->
317   - get_chars_apply(Mod, Func, XtraArg, S, State, Bin);
318   - eof ->
319   - get_chars_apply(Mod, Func, XtraArg, S, State, eof);
320   - {error,Reason}=Error ->
321   - {stop,Reason,Error,State}
322   - end.
323   -
324   -get_chars_apply(Mod, Func, XtraArg, S0,
325   - #state{read_mode=ReadMode}=State, Data0) ->
326   - Data1 = case ReadMode of
327   - list when binary(Data0) -> binary_to_list(Data0);
328   - _ -> Data0
329   - end,
330   - case catch Mod:Func(S0, Data1, XtraArg) of
331   - {stop,Result,Buf} ->
332   - {reply,Result,State#state{buf=cast_binary(Buf)}};
333   - {'EXIT',Reason} ->
334   - {stop,Reason,{error,err_func(Mod, Func, XtraArg)},State};
335   - S1 ->
336   - get_chars_empty(Mod, Func, XtraArg, S1, State)
337   - end.
338   -
339   -%% Convert error code to make it look as before
340   -err_func(io_lib, get_until, {_,F,_}) ->
341   - F;
342   -err_func(_, F, _) ->
343   - F.
344   -
345   -
346   -
347   -%% Process the I/O request setopts
348   -%%
349   -%% setopts
350   -setopts(Opts0, State) ->
351   - Opts = proplists:substitute_negations([{list,binary}], Opts0),
352   - case proplists:get_value(binary, Opts) of
353   - true ->
354   - {ok,ok,State#state{read_mode=binary}};
355   - false ->
356   - {ok,ok,State#state{read_mode=list}};
357   - _ ->
358   - {error,{error,badarg},State}
359   - end.
360   -
361   -
362   -
363   -%% Concatenate two binaries and convert the result to list or binary
364   -cat(B1, B2, binary) ->
365   - list_to_binary([B1,B2]);
366   -cat(B1, B2, list) ->
367   - binary_to_list(B1)++binary_to_list(B2).
368   -
369   -%% Cast binary to list or binary
370   -cast(B, binary) ->
371   - B;
372   -cast(B, list) ->
373   - binary_to_list(B).
374   -
375   -%% Convert buffer to binary
376   -cast_binary(Binary) when binary(Binary) ->
377   - Binary;
378   -cast_binary(List) when list(List) ->
379   - list_to_binary(List);
380   -cast_binary(_EOF) ->
381   - <<>>.
382   -
383   -%% Read size for different read modes
384   -read_size(binary) ->
385   - ?READ_SIZE_BINARY;
386   -read_size(list) ->
387   - ?READ_SIZE_LIST.
388   -
389   -max(A, B) when A >= B ->
390   - A;
391   -max(_, B) ->
392   - B.
393   -
394   -%%%-----------------------------------------------------------------
395   -%%% ?PRIM_FILE helpers
396   -
397   -%% Compensates ?PRIM_FILE:position/2 for the number of bytes
398   -%% we have buffered
399   -
400   -position(Handle, cur, Buf) ->
401   - position(Handle, {cur, 0}, Buf);
402   -position(Handle, {cur, Offs}, Buf) when list(Buf) ->
403   - ?PRIM_FILE:position(Handle, {cur, Offs-length(Buf)});
404   -position(Handle, {cur, Offs}, Buf) when binary(Buf) ->
405   - ?PRIM_FILE:position(Handle, {cur, Offs-size(Buf)});
406   -position(Handle, At, _Buf) ->
407   - ?PRIM_FILE:position(Handle, At).
408   -

0 comments on commit dff6e28

Please sign in to comment.
Something went wrong with that request. Please try again.