Ticket #21622: dynamic_compile_loglevel.patch

File dynamic_compile_loglevel.patch, 28.9 KB (added by smbmacportstrac@…, 15 years ago)

Thanks to Geoff Cant, #EJAB-919

  • new file dynamic_compile.erl 

    diff --git dynamic_compile.erl dynamic_compile.erl
new file mode 100644
index 0000000..1fe2dca
    - +  
     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%%--------------------------------------------------------------------
     57from_string(CodeStr) ->
     58    from_string(CodeStr, []).
     59
     60% takes Options as for compile:forms/2
     61from_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}
     108scan_and_parse([], _CurrFilename, _CurrLine, RevForms, MacroDict, _IncludeSearchPath) ->
     109    {RevForms, MacroDict};
     110
     111scan_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
     138scanner(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
     159is_only_comments(Text) -> is_only_comments(Text, not_in_comment).
     160
     161is_only_comments([],       _)              -> true;
     162is_only_comments([$   |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
     163is_only_comments([$\t |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
     164is_only_comments([$\n |T], not_in_comment) -> is_only_comments(T, not_in_comment); % skipping whitspace outside of comment
     165is_only_comments([$%  |T], not_in_comment) -> is_only_comments(T, in_comment);     % found start of a comment
     166is_only_comments(_,        not_in_comment) -> false;
     167% found any significant char NOT in a comment
     168is_only_comments([$\n |T], in_comment)     -> is_only_comments(T, not_in_comment); % found end of a comment
     169is_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}).
     178pre_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
     187pre_proc([{'-',_}, {atom,_,include}, {'(',_}, {string,_,Filename}, {')',_}, {dot,_}], _MacroDict) ->
     188    {include, Filename};
     189
     190pre_proc(Toks,MacroDict) ->
     191    {tokens, subst_macros(Toks, MacroDict)}.
     192
     193macro_params_body_def([{')',_},{',',_} | Toks], RevParams) ->
     194    {reverse(RevParams), macro_body_def(Toks, [])};
     195macro_params_body_def([{var,_,Param} | Toks], RevParams) ->
     196    macro_params_body_def(Toks, [Param | RevParams]);
     197macro_params_body_def([{',',_}, {var,_,Param} | Toks], RevParams) ->
     198    macro_params_body_def(Toks, [Param | RevParams]).
     199
     200macro_body_def([{')',_}, {dot,_}], RevMacroBodyToks) ->
     201    reverse(RevMacroBodyToks);
     202macro_body_def([Tok|Toks], RevMacroBodyToks) ->
     203    macro_body_def(Toks, [Tok | RevMacroBodyToks]).
     204
     205subst_macros(Toks, MacroDict) ->
     206    reverse(subst_macros_rev(Toks, MacroDict, [])).
     207
     208%% returns a reversed list of tokes
     209subst_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
     213subst_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
     233subst_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
     243subst_macros_rev([Tok|Toks], MacroDict,  RevOutToks) ->
     244subst_macros_rev(Toks, MacroDict, [Tok|RevOutToks]);
     245subst_macros_rev([], _MacroDict, RevOutToks) -> RevOutToks.
     246
     247subst_macros_get_args([{')',_} | Toks], RevArgs) ->
     248    {Toks, reverse(RevArgs)};
     249subst_macros_get_args([{',',_}, {var,_,ArgName} | Toks], RevArgs) ->
     250    subst_macros_get_args(Toks, [ArgName| RevArgs]);
     251subst_macros_get_args([{var,_,ArgName} | Toks], RevArgs) ->
     252    subst_macros_get_args(Toks, [ArgName | RevArgs]).
     253
     254subst_macros_subst_args_for_vars({[], BodyToks}, []) ->
     255    BodyToks;
     256subst_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
     260read_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.
     269 No newline at end of file

  • ejabberd.app 

    diff --git ejabberd.app ejabberd.app
index 1ff41ec..7f0948f 100644
     
    115115             nodetree_virtual,
    116116             p1_fsm,
    117117             p1_mnesia,
    118              ram_file_io_server,
    119118             randoms,
    120119             sha,
    121120             shaper,

  • ejabberd_loglevel.erl 

    diff --git ejabberd_loglevel.erl ejabberd_loglevel.erl
index 3134d4d..2a34060 100644
     
    3838-define(LOGMODULE, "error_logger").
    3939
    4040%% 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
     49set(LogLevel) when is_atom(LogLevel) ->
     50    set(level_to_integer(LogLevel));
    4751set(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;
    5058set(_) ->
    5159    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].
    7860
    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])
     61level_to_integer(Level) ->
     62    case lists:keyfind(Level, 2, ?LOG_LEVELS) of
     63        {Int, Level, _Desc} -> Int;
     64        _ -> erlang:error({no_such_loglevel, Level})
    8665    end.
    8766
    8867%% --------------------------------------------------------------

  • deleted file ram_file_io_server.erl 

    diff --git ram_file_io_server.erl ram_file_io_server.erl
    + -  
    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: ram_file_io_server.erl 970 2007-11-15 10:33:18Z mremond $
    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