From dff6e28b2daca542c38b5f139b00aaea413d810a Mon Sep 17 00:00:00 2001 From: Badlop Date: Wed, 6 May 2009 14:51:51 +0000 Subject: [PATCH] * 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 --- ChangeLog | 11 + src/dynamic_compile.erl | 268 ++++++++++++++++++++++++ src/ejabberd.app | 1 - src/ejabberd_loglevel.erl | 61 ++---- src/ram_file_io_server.erl | 408 ------------------------------------- 5 files changed, 299 insertions(+), 450 deletions(-) create mode 100644 src/dynamic_compile.erl delete mode 100644 src/ram_file_io_server.erl diff --git a/ChangeLog b/ChangeLog index 44e8ce592..b19979e21 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2009-05-06 Badlop + + * 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 * src/mod_muc/mod_muc_room.erl: Fix badarg return (EJAB-899) diff --git a/src/dynamic_compile.erl b/src/dynamic_compile.erl new file mode 100644 index 000000000..1fe2dcaad --- /dev/null +++ b/src/dynamic_compile.erl @@ -0,0 +1,268 @@ +%% Copyright (c) 2007 +%% Mats Cronqvist +%% Chris Newcombe +%% Jacob Vorreuter +%% +%% 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 +%%% Chris Newcombe +%%% Jacob Vorreuter +%%% 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. \ No newline at end of file diff --git a/src/ejabberd.app b/src/ejabberd.app index 1ff41ec46..7f0948f04 100644 --- a/src/ejabberd.app +++ b/src/ejabberd.app @@ -115,7 +115,6 @@ nodetree_virtual, p1_fsm, p1_mnesia, - ram_file_io_server, randoms, sha, shaper, diff --git a/src/ejabberd_loglevel.erl b/src/ejabberd_loglevel.erl index 3134d4d03..2a340606b 100644 --- a/src/ejabberd_loglevel.erl +++ b/src/ejabberd_loglevel.erl @@ -38,51 +38,30 @@ -define(LOGMODULE, "error_logger"). %% Error levels: -%% 0 -> No log -%% 1 -> Critical -%% 2 -> Error -%% 3 -> Warning -%% 4 -> Info -%% 5 -> Debug +-define(LOG_LEVELS,[ {0, no_log, "No log"} + ,{1, critical, "Critical"} + ,{2, error, "Error"} + ,{3, warning, "Warning"} + ,{4, info, "Info"} + ,{5, debug, "Debug"} + ]). + +set(LogLevel) when is_atom(LogLevel) -> + set(level_to_integer(LogLevel)); set(Loglevel) when is_integer(Loglevel) -> - Forms = compile_string(?LOGMODULE, ejabberd_logger_src(Loglevel)), - load_logger(Forms, ?LOGMODULE, Loglevel); + try + {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(_) -> exit("Loglevel must be an integer"). - -%% -------------------------------------------------------------- -%% Compile a string into a module and returns the binary -compile_string(Mod, Str) -> - Fname = Mod ++ ".erl", - {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]) +level_to_integer(Level) -> + case lists:keyfind(Level, 2, ?LOG_LEVELS) of + {Int, Level, _Desc} -> Int; + _ -> erlang:error({no_such_loglevel, Level}) end. %% -------------------------------------------------------------- diff --git a/src/ram_file_io_server.erl b/src/ram_file_io_server.erl deleted file mode 100644 index 197cfa806..000000000 --- a/src/ram_file_io_server.erl +++ /dev/null @@ -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). -