Support old-style shell for rebar3 shell

This is quite the hack.

This requires to detect the current shell running; if it's the new
shell, business as usual.

However, if it's the old shell, we have to find a way to take over it
and drive IO. This requires a few steps because:

- the old shell does not let you be supervised intelligently (it uses
  supervisor_bridge, so killing the child is not a supported operation
  from the supervisor)
- the old shell ignores all trappable exit signals except those coming
  from the Port in charge of stdio ({fd, 0, 1})
- the old shell shuts down on all exit signals from the stdio Port
  except for badsig, and replicates the shutdown reason otherwise
- An escript does not tolerate the `user` process dying (old shell) for
  any non-normal reason without also taking the whole escript down
- Booting in an escript has an implicit 'noshell' argument interpreted
  by the old shell as a way to boot the stdio Port with only stdout
  taken care of

Because of all these points, we have to kill the old `user` process by
sending it a message pretending to be the Stdio port dying of reason
`normal`, which lets it die without triggering the ire of its
supervision tree and keeping the escript alive. This, in turn, kills the
old stdio port since its parent (user.erl) has died.

Then we have to boot our copy of user.erl (rebar_user.erl) which
conveniently ignores the possibility of running the stdio port on stdout
only -- always using stdin *and* stdout, giving us a bona fide old-style
shell.

A known issue introduced is that running r3:do(ct) seems to then kill
the shell, and r3:do(dialyzer) appears to have an odd failure, but
otherwise most other commands appear to work fine.

2 files changed, 781 insertions, 0 deletions

diff --git a/src/rebar_prv_shell.erl b/src/rebar_prv_shell.erl
index c644930..b2479f1 100644
--- a/src/rebar_prv_shell.erl
+++ b/src/rebar_prv_shell.erl
@@ -27,6 +27,7 @@
 
 -module(rebar_prv_shell).
 -author("Kresten Krab Thorup <krab@trifork.com>").
+-author("Fred Hebert <mononcqc@ferd.ca>").
 
 -behaviour(provider).
 
@@ -111,6 +112,12 @@ info() ->
     "Start a shell with project and deps preloaded similar to~n'erl -pa ebin -pa deps/*/ebin'.~n".
 
 setup_shell() ->
+    case process_info(whereis(user), current_function) of
+        {_,{user,_,_}} -> setup_old_shell();
+        _ -> setup_new_shell()
+    end.
+
+setup_new_shell() ->
     %% scan all processes for any with references to the old user and save them to
     %% update later
     OldUser = whereis(user),
@@ -121,6 +128,22 @@ setup_shell() ->
     %% wait until user_drv and user have been registered (max 3 seconds)
     ok = wait_until_user_started(3000),
     NewUser = whereis(user),
+    rewrite_leaders(OldUser, NewUser).
+
+setup_old_shell() ->
+    %% scan all processes for any with references to the old user and save them to
+    %% update later
+    OldUser = whereis(user),
+    %% terminate the current user's port, in a way that makes it shut down,
+    %% but without taking down the supervision tree so that the escript doesn't
+    %% fully die
+    [P] = [P || P <- element(2,process_info(whereis(user), links)), is_port(P)],
+    user ! {'EXIT', P, normal}, % pretend the port died, then the port can die!
+    NewUser = rebar_user:start(), % hikack IO stuff with fake user
+    NewUser = whereis(user),
+    rewrite_leaders(OldUser, NewUser).
+
+rewrite_leaders(OldUser, NewUser) ->
     %% set any process that had a reference to the old user's group leader to the
     %% new user process. Catch the race condition when the Pid exited after the
     %% liveness check.
@@ -154,6 +177,7 @@ setup_shell() ->
             hope_for_best
     end.
 
+
 setup_paths(State) ->
     %% Add deps to path
     code:add_pathsa(rebar_state:code_paths(State, all_deps)),
diff --git a/src/rebar_user.erl b/src/rebar_user.erl
new file mode 100644
index 0000000..f20142d
--- /dev/null
+++ b/src/rebar_user.erl
@@ -0,0 +1,757 @@
+%%% This file is a literal copy of Erlang/OTP's user.erl module, renamed
+%%% to rebar_user.erl and modified in a few place to force a shell to always
+%%% boot or to remove dead comments.
+%%%
+%%% Its usage is required because unlike the standard (new) shell, it is
+%%% not possible to get rid of the old one without killing the rebar3 escript
+%%% at the same time. As such, this module is being used to duplicate
+%%% the old shell while stealing the usage of the IO driver {fd,0,1}
+%%% (stdio) and then booting our own shell with paths and stuff in it.
+
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(rebar_user).
+-compile(inline).
+
+%% Basic standard i/o server for user interface port.
+
+-export([start/0, start/1, start_out/0]).
+-export([interfaces/1]).
+
+-define(NAME, user).
+
+%% Defines for control ops
+-define(CTRL_OP_GET_WINSIZE,100).
+
+%%
+%% The basic server and start-up.
+%%
+
+start() ->
+    start_port([eof,binary]).
+
+start([Mod,Fun|Args]) ->
+    %% Mod,Fun,Args should return a pid. That process is supposed to act
+    %% as the io port.
+    Pid = apply(Mod, Fun, Args),  % This better work!
+    Id = spawn(fun() -> server(Pid) end),
+    register(?NAME, Id),
+    Id.
+
+start_out() ->
+    %% Output-only version of start/0
+    start_port([out,binary]).
+
+start_port(PortSettings) ->
+    Id = spawn(fun() -> server({fd,0,1}, PortSettings) end),
+    register(?NAME, Id),
+    Id.
+
+%% Return the pid of the shell process.
+%% Note: We can't ask the user process for this info since it
+%% may be busy waiting for data from the port.
+interfaces(User) ->
+    case process_info(User, dictionary) of
+	{dictionary,Dict} ->
+	    case lists:keysearch(shell, 1, Dict) of
+		{value,Sh={shell,Shell}} when is_pid(Shell) ->
+		    [Sh];
+		_ ->
+		    []
+	    end;
+	_ ->
+	    []
+    end.
+
+server(Pid) when is_pid(Pid) ->
+    process_flag(trap_exit, true),
+    link(Pid),
+    run(Pid).
+
+server(PortName,PortSettings) ->
+    process_flag(trap_exit, true),
+    Port = open_port(PortName,PortSettings),
+    run(Port).
+
+run(P) ->
+    put(read_mode,list),
+    put(encoding,latin1),
+    group_leader(self(), self()),
+    catch_loop(P, start_init_shell()).
+
+catch_loop(Port, Shell) ->
+    catch_loop(Port, Shell, queue:new()).
+
+catch_loop(Port, Shell, Q) ->
+    case catch server_loop(Port, Q) of
+	new_shell ->
+	    exit(Shell, kill),
+	    catch_loop(Port, start_new_shell());
+	{unknown_exit,{Shell,Reason},_} ->		 % shell has exited
+	    case Reason of
+		normal ->
+                    put_port(<<"*** ">>, Port);
+		_ ->
+                    put_port(<<"*** ERROR: ">>, Port)
+	    end,
+	    put_port(<<"Shell process terminated! ***\n">>, Port),
+	    catch_loop(Port, start_new_shell());
+	{unknown_exit,_,Q1} ->
+	    catch_loop(Port, Shell, Q1);	     
+	{'EXIT',R} ->
+	    exit(R)
+    end.
+
+link_and_save_shell(Shell) ->
+    link(Shell),
+    put(shell, Shell),
+    Shell.        
+
+start_init_shell() ->
+    link_and_save_shell(shell:start(init)).
+
+start_new_shell() ->
+    link_and_save_shell(shell:start()).
+
+server_loop(Port, Q) ->
+    receive
+	{io_request,From,ReplyAs,Request} when is_pid(From) ->
+	    server_loop(Port, do_io_request(Request, From, ReplyAs, Port, Q));
+	{Port,{data,Bytes}} ->
+	    case get(shell) of
+		noshell ->
+		    server_loop(Port, queue:snoc(Q, Bytes));
+		_ ->
+		    case contains_ctrl_g_or_ctrl_c(Bytes) of
+			false ->
+			    server_loop(Port, queue:snoc(Q, Bytes));
+			_ ->
+			    throw(new_shell)
+		    end
+	    end;
+	{Port, eof} ->
+	    put(eof, true),
+	    server_loop(Port, Q);
+
+	%% Ignore messages from port here.
+	{'EXIT',Port,badsig} ->			% Ignore badsig errors
+	    server_loop(Port, Q);
+	{'EXIT',Port,What} ->			% Port has exited
+	    exit(What);
+
+	%% Check if shell has exited
+	{'EXIT',SomePid,What} ->
+	    case get(shell) of
+		noshell ->
+		    server_loop(Port, Q);	% Ignore
+		_ ->
+		    throw({unknown_exit,{SomePid,What},Q})
+	    end;
+	
+	_Other ->				% Ignore other messages
+	    server_loop(Port, Q)
+    end.
+
+
+get_fd_geometry(Port) ->
+    case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of
+	List when length(List) =:= 8 ->
+	    <<W:32/native,H:32/native>> = list_to_binary(List),
+	    {W,H};
+	_ ->
+	    error
+    end.
+
+
+%% NewSaveBuffer = io_request(Request, FromPid, ReplyAs, Port, SaveBuffer)
+
+do_io_request(Req, From, ReplyAs, Port, Q0) ->
+    case io_request(Req, Port, Q0) of
+	{_Status,Reply,Q1} ->
+	    _ = io_reply(From, ReplyAs, Reply),
+	    Q1;
+	{exit,What} ->
+	    ok = send_port(Port, close),
+	    exit(What)
+    end.
+
+%% New in R13B
+%% Encoding option (unicode/latin1)
+io_request({put_chars,unicode,Chars}, Port, Q) -> % Binary new in R9C
+    case wrap_characters_to_binary(Chars, unicode, get(encoding)) of
+        error ->
+            {error,{error,put_chars},Q};
+        Bin ->
+           put_chars(Bin, Port, Q)
+    end;
+io_request({put_chars,unicode,Mod,Func,Args}, Port, Q) ->
+    case catch apply(Mod,Func,Args) of
+        Data when is_list(Data); is_binary(Data) ->
+            case wrap_characters_to_binary(Data, unicode, get(encoding)) of
+                Bin when is_binary(Bin) ->
+                    put_chars(Bin, Port, Q);
+                error ->
+                    {error,{error,put_chars},Q}
+            end;
+        Undef ->
+            put_chars(Undef, Port, Q)
+    end;
+io_request({put_chars,latin1,Chars}, Port, Q) -> % Binary new in R9C
+    case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of
+        Data when is_binary(Data) ->
+            put_chars(Data, Port, Q);
+        _ ->
+            {error,{error,put_chars},Q}
+    end;
+io_request({put_chars,latin1,Mod,Func,Args}, Port, Q) ->
+    case catch apply(Mod,Func,Args) of
+        Data when is_list(Data); is_binary(Data) ->
+            case
+                catch unicode:characters_to_binary(Data,latin1,get(encoding))
+            of
+                Bin when is_binary(Bin) ->
+                    put_chars(Bin, Port, Q);
+                _ ->
+                    {error,{error,put_chars},Q}
+            end;
+        Undef ->
+            put_chars(Undef, Port, Q)
+    end;
+io_request({get_chars,Enc,Prompt,N}, Port, Q) -> % New in R9C
+    get_chars(Prompt, io_lib, collect_chars, N, Port, Q, Enc);
+io_request({get_line,Enc,Prompt}, Port, Q) ->
+    case get(read_mode) of
+	binary ->
+	    get_line_bin(Prompt,Port,Q,Enc);
+	_ ->
+	    get_chars(Prompt, io_lib, collect_line, [], Port, Q, Enc)
+    end;
+io_request({get_until,Enc,Prompt,M,F,As}, Port, Q) ->
+    get_chars(Prompt, io_lib, get_until, {M,F,As}, Port, Q, Enc);
+%%  End New in R13B
+io_request(getopts, Port, Q) ->
+    getopts(Port, Q);
+io_request({setopts,Opts}, Port, Q) when is_list(Opts) ->
+    setopts(Opts, Port, Q);
+io_request({requests,Reqs}, Port, Q) ->
+    io_requests(Reqs, {ok,ok,Q}, Port);
+
+%% New in R12
+io_request({get_geometry,columns},Port,Q) ->
+    case get_fd_geometry(Port) of
+	{W,_H} ->
+	    {ok,W,Q};
+	_ ->
+	    {error,{error,enotsup},Q}
+    end;
+io_request({get_geometry,rows},Port,Q) ->
+    case get_fd_geometry(Port) of
+	{_W,H} ->
+	    {ok,H,Q};
+	_ ->
+	    {error,{error,enotsup},Q}
+    end;
+%% BC with pre-R13 nodes
+io_request({put_chars,Chars}, Port, Q) ->
+    io_request({put_chars,latin1,Chars}, Port, Q);
+io_request({put_chars,Mod,Func,Args}, Port, Q) ->
+    io_request({put_chars,latin1,Mod,Func,Args}, Port, Q);
+io_request({get_chars,Prompt,N}, Port, Q) -> 
+    io_request({get_chars,latin1,Prompt,N}, Port, Q);
+io_request({get_line,Prompt}, Port, Q) ->
+    io_request({get_line,latin1,Prompt}, Port, Q);
+io_request({get_until,Prompt,M,F,As}, Port, Q) ->
+    io_request({get_until,latin1,Prompt,M,F,As}, Port, Q);
+
+io_request(R, _Port, Q) ->                      %Unknown request
+    {error,{error,{request,R}},Q}.		%Ignore but give error (?)
+
+%% Status = io_requests(RequestList, PrevStat, Port)
+%%  Process a list of output requests as long as the previous status is 'ok'.
+
+io_requests([R|Rs], {ok,_Res,Q}, Port) ->
+    io_requests(Rs, io_request(R, Port, Q), Port);
+io_requests([_|_], Error, _) ->
+    Error;
+io_requests([], Stat, _) ->
+    Stat.
+
+%% put_port(DeepList, Port)
+%%  Take a deep list of characters, flatten and output them to the
+%%  port.
+
+put_port(List, Port) ->
+    send_port(Port, {command, List}).
+
+%% send_port(Port, Command)
+
+send_port(Port, Command) ->
+    Port ! {self(),Command},
+    ok.
+
+%% io_reply(From, ReplyAs, Reply)
+%%  The function for sending i/o command acknowledgement.
+%%  The ACK contains the return value.
+
+io_reply(From, ReplyAs, Reply) ->
+    From ! {io_reply,ReplyAs,Reply}.
+
+%% put_chars
+put_chars(Chars, Port, Q) when is_binary(Chars) ->
+    ok = put_port(Chars, Port),
+    {ok,ok,Q};
+put_chars(Chars, Port, Q) ->
+    case catch list_to_binary(Chars) of
+	Binary when is_binary(Binary) ->
+	    put_chars(Binary, Port, Q);
+	_ ->
+	    {error,{error,put_chars},Q}
+    end.
+
+expand_encoding([]) ->
+    [];
+expand_encoding([latin1 | T]) ->
+    [{encoding,latin1} | expand_encoding(T)];
+expand_encoding([unicode | T]) ->
+    [{encoding,unicode} | expand_encoding(T)];
+expand_encoding([H|T]) ->
+    [H|expand_encoding(T)].
+
+%% setopts
+setopts(Opts0,Port,Q) ->
+    Opts = proplists:unfold(
+	     proplists:substitute_negations(
+	       [{list,binary}], 
+	       expand_encoding(Opts0))),
+    case check_valid_opts(Opts) of
+	true ->
+	    do_setopts(Opts,Port,Q);
+	false ->
+	    {error,{error,enotsup},Q}
+    end.
+check_valid_opts([]) ->
+    true;
+check_valid_opts([{binary,_}|T]) ->
+    check_valid_opts(T);
+check_valid_opts([{encoding,Valid}|T]) when Valid =:= latin1; Valid =:= utf8; Valid =:= unicode ->
+    check_valid_opts(T);
+check_valid_opts(_) ->
+    false.
+
+do_setopts(Opts, _Port, Q) ->
+    case proplists:get_value(encoding,Opts) of
+	Valid when Valid =:= unicode; Valid =:= utf8 ->
+	    put(encoding,unicode);
+	latin1 ->
+	    put(encoding,latin1);
+	undefined ->
+	    ok
+    end,
+    case proplists:get_value(binary, Opts) of
+	true ->
+	    put(read_mode,binary),
+	    {ok,ok,Q};
+	false ->
+	    put(read_mode,list),
+	    {ok,ok,Q};
+	_ ->
+	    {ok,ok,Q}
+    end.
+
+getopts(_Port,Q) ->
+    Bin = {binary, get(read_mode) =:= binary},
+    Uni = {encoding, get(encoding)},
+    {ok,[Bin,Uni],Q}.
+
+get_line_bin(Prompt,Port,Q, Enc) ->
+    case prompt(Port, Prompt) of
+        error ->
+	    {error,{error,get_line},Q};
+        ok ->
+            case {get(eof),queue:is_empty(Q)} of
+                {true,true} ->
+                    {ok,eof,Q};
+                _ ->
+                    get_line(Prompt,Port, Q, [], Enc)
+            end
+    end.
+
+get_line(Prompt, Port, Q, Acc, Enc) ->
+    case queue:is_empty(Q) of
+	true ->
+	    receive
+		{Port,{data,Bytes}} ->
+		    get_line_bytes(Prompt, Port, Q, Acc, Bytes, Enc);
+		{Port, eof} ->
+		    put(eof, true),
+		    {ok, eof, []};
+                {io_request,From,ReplyAs,{get_geometry,_}=Req} when is_pid(From) ->
+                    do_io_request(Req, From, ReplyAs, Port, 
+                                  queue:new()), 
+                    %% No prompt.
+                    get_line(Prompt, Port, Q, Acc, Enc);
+		{io_request,From,ReplyAs,Request} when is_pid(From) ->
+		    do_io_request(Request, From, ReplyAs, Port, queue:new()), 
+                    case prompt(Port, Prompt) of
+                        error ->
+                            {error,{error,get_line},Q};
+                        ok ->
+                            get_line(Prompt, Port, Q, Acc, Enc)
+                    end;
+		{'EXIT',From,What} when node(From) =:= node() ->
+		    {exit,What}
+	    end;
+	false ->
+	    get_line_doit(Prompt, Port, Q, Acc, Enc)
+    end.
+
+get_line_bytes(Prompt, Port, Q, Acc, Bytes, Enc) ->
+    case get(shell) of
+	noshell ->
+	    get_line_doit(Prompt, Port, queue:snoc(Q, Bytes),Acc,Enc);
+	_ ->
+	    case contains_ctrl_g_or_ctrl_c(Bytes) of
+		false ->
+		    get_line_doit(Prompt, Port, queue:snoc(Q, Bytes), Acc, Enc);
+		_ ->
+		    throw(new_shell)
+	    end
+    end.
+is_cr_at(Pos,Bin) ->
+    case Bin of
+  	<<_:Pos/binary,$\r,_/binary>> ->
+  	    true;
+  	_ ->
+  	    false
+    end.
+srch(<<>>,_,_) ->
+    nomatch;
+srch(<<X:8,_/binary>>,X,N) ->
+    {match,[{N,1}]};
+srch(<<_:8,T/binary>>,X,N) ->
+    srch(T,X,N+1).
+
+get_line_doit(Prompt, Port, Q, Accu, Enc) -> 
+    case queue:is_empty(Q) of
+	true ->
+	    case get(eof) of
+		true ->
+		   case Accu of
+		       [] ->
+			   {ok,eof,Q};
+		       _ ->
+			   {ok,binrev(Accu,[]),Q}
+		   end;
+		_ ->
+		    get_line(Prompt, Port, Q, Accu, Enc)
+	    end;
+	false ->
+	    Bin = queue:head(Q),
+	    case srch(Bin,$\n,0) of
+		nomatch ->
+		    X = byte_size(Bin)-1,
+		    case is_cr_at(X,Bin) of
+			true ->
+			    <<D:X/binary,_/binary>> = Bin,
+			    get_line_doit(Prompt, Port, queue:tail(Q), 
+					  [<<$\r>>,D|Accu], Enc); 
+			false ->
+			    get_line_doit(Prompt, Port, queue:tail(Q), 
+					  [Bin|Accu], Enc)
+		    end;
+		{match,[{Pos,1}]} ->
+		    %% We are done
+		    PosPlus = Pos + 1,
+		    case Accu of
+			[] ->
+			    {Head,Tail} = 
+				case is_cr_at(Pos - 1,Bin) of
+				    false ->
+					<<H:PosPlus/binary,
+					 T/binary>> = Bin,
+					{H,T};
+				    true ->
+					PosMinus = Pos - 1,
+					<<H:PosMinus/binary,
+					 _,_,T/binary>> = Bin,
+					{binrev([],[H,$\n]),T}
+				end,
+			    case Tail of
+				<<>> ->
+				    {ok, cast(Head,Enc), queue:tail(Q)};
+				_ ->
+				    {ok, cast(Head,Enc), 
+				     queue:cons(Tail, queue:tail(Q))}
+			    end;
+			[<<$\r>>|Stack1] when Pos =:= 0 ->
+			    <<_:PosPlus/binary,Tail/binary>> = Bin, 
+			    case Tail of
+				<<>> ->
+				    {ok, cast(binrev(Stack1, [$\n]),Enc), 
+				     queue:tail(Q)};
+				_ ->
+				    {ok, cast(binrev(Stack1, [$\n]),Enc), 
+				     queue:cons(Tail, queue:tail(Q))}
+			    end;
+			_ ->
+			    {Head,Tail} = 
+				case is_cr_at(Pos - 1,Bin) of
+				    false ->
+					<<H:PosPlus/binary,
+					 T/binary>> = Bin,
+					{H,T};
+				    true ->
+					PosMinus = Pos - 1,
+					<<H:PosMinus/binary,
+					 _,_,T/binary>> = Bin,
+					{[H,$\n],T}
+				end,
+			    case Tail of
+				<<>> ->
+				    {ok, cast(binrev(Accu,[Head]),Enc), 
+				     queue:tail(Q)};
+				_ ->
+				    {ok, cast(binrev(Accu,[Head]),Enc), 
+				     queue:cons(Tail, queue:tail(Q))}
+			    end
+		    end
+	    end
+    end.
+
+binrev(L, T) ->
+    list_to_binary(lists:reverse(L, T)).
+
+%% Entry function.
+get_chars(Prompt, M, F, Xa, Port, Q, Enc) ->
+    case prompt(Port, Prompt) of
+        error ->
+            {error,{error,get_chars},Q};
+        ok ->
+            case {get(eof),queue:is_empty(Q)} of
+                {true,true} ->
+                    {ok,eof,Q};
+                _ ->
+                    get_chars(Prompt, M, F, Xa, Port, Q, start, Enc)
+            end
+    end.
+
+%% First loop. Wait for port data. Respond to output requests.
+get_chars(Prompt, M, F, Xa, Port, Q, State, Enc) ->
+    case queue:is_empty(Q) of
+	true ->
+	    receive
+		{Port,{data,Bytes}} ->
+		    get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc);
+		{Port, eof} ->
+		    put(eof, true),
+		    {ok, eof, []};
+                {io_request,From,ReplyAs,{get_geometry,_}=Req} when is_pid(From) ->
+                    do_io_request(Req, From, ReplyAs, Port, 
+                                  queue:new()), %Keep Q over this call
+                    %% No prompt.
+                    get_chars(Prompt, M, F, Xa, Port, Q, State, Enc);
+		{io_request,From,ReplyAs,Request} when is_pid(From) ->
+		    get_chars_req(Prompt, M, F, Xa, Port, Q, State,
+				  Request, From, ReplyAs, Enc);
+		{'EXIT',From,What} when node(From) =:= node() ->
+		    {exit,What}
+	    end;
+	false ->
+	    get_chars_apply(State, M, F, Xa, Port, Q, Enc)
+    end.
+
+get_chars_req(Prompt, M, F, XtraArg, Port, Q, State,
+	      Req, From, ReplyAs, Enc) ->
+    do_io_request(Req, From, ReplyAs, Port, queue:new()), %Keep Q over this call
+    case prompt(Port, Prompt) of
+        error ->
+            {error,{error,get_chars},Q};
+        ok ->
+            get_chars(Prompt, M, F, XtraArg, Port, Q, State, Enc)
+    end.
+
+%% Second loop. Pass data to client as long as it wants more.
+%% A ^G in data interrupts loop if 'noshell' is not undefined.
+get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc) ->
+    case get(shell) of
+	noshell ->
+	    get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, Bytes),Enc);
+	_ ->
+	    case contains_ctrl_g_or_ctrl_c(Bytes) of
+		false ->
+		    get_chars_apply(State, M, F, Xa, Port, 
+				    queue:snoc(Q, Bytes),Enc);
+		_ ->
+		    throw(new_shell)
+	    end
+    end.
+
+get_chars_apply(State0, M, F, Xa, Port, Q, Enc) ->
+    case catch M:F(State0, cast(queue:head(Q),Enc), Enc, Xa) of
+	{stop,Result,<<>>} ->
+	    {ok,Result,queue:tail(Q)};
+	{stop,Result,[]} ->
+	    {ok,Result,queue:tail(Q)};
+	{stop,Result,eof} ->
+	    {ok,Result,queue:tail(Q)};
+	{stop,Result,Buf} ->
+	    {ok,Result,queue:cons(Buf, queue:tail(Q))};
+	{'EXIT',_Why} ->
+	    {error,{error,err_func(M, F, Xa)},queue:new()};
+	State1 ->
+	    get_chars_more(State1, M, F, Xa, Port, queue:tail(Q), Enc)
+    end.
+
+get_chars_more(State, M, F, Xa, Port, Q, Enc) ->
+    case queue:is_empty(Q) of
+	true ->
+	    case get(eof) of
+		undefined ->
+		    receive
+			{Port,{data,Bytes}} ->
+			    get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc);
+			{Port,eof} ->
+			    put(eof, true),
+			    get_chars_apply(State, M, F, Xa, Port, 
+					    queue:snoc(Q, eof), Enc);
+			{'EXIT',From,What} when node(From) =:= node() ->
+			    {exit,What}
+		    end;
+		_ ->
+		    get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, eof), Enc)
+	    end;
+	false ->
+	    get_chars_apply(State, M, F, Xa, Port, Q, Enc)
+    end.
+
+%% common case, reduces execution time by 20%
+prompt(_Port, '') -> ok;
+prompt(Port, Prompt) ->
+    Encoding = get(encoding),
+    PromptString = io_lib:format_prompt(Prompt, Encoding),
+    case wrap_characters_to_binary(PromptString, unicode, Encoding) of
+        Bin when is_binary(Bin) ->
+            put_port(Bin, Port);
+        error ->
+            error
+    end.
+
+%% Convert error code to make it look as before
+err_func(io_lib, get_until, {_,F,_}) ->
+    F;
+err_func(_, F, _) ->
+    F.
+
+%% using regexp reduces execution time by >50% compared to old code
+%% running two regexps in sequence is much faster than \\x03|\\x07
+contains_ctrl_g_or_ctrl_c(BinOrList)->
+    case {re:run(BinOrList, <<3>>),re:run(BinOrList, <<7>>)} of
+	{nomatch, nomatch} -> false;
+	_ -> true
+    end.
+
+%% Convert a buffer between list and binary
+cast(Data, _Encoding) when is_atom(Data) ->
+    Data;
+cast(Data, Encoding) ->
+    IoEncoding =  get(encoding),
+    cast(Data, get(read_mode), IoEncoding, Encoding).
+
+cast(B, binary, latin1, latin1) when is_binary(B) ->
+    B;
+cast(L, binary, latin1, latin1) ->
+    case catch erlang:iolist_to_binary(L) of
+        Bin when is_binary(Bin) -> Bin;
+        _ -> exit({no_translation, latin1, latin1})
+    end;
+cast(Data, binary, unicode, latin1) when is_binary(Data); is_list(Data) ->
+    case catch unicode:characters_to_binary(Data, unicode, latin1) of
+        Bin when is_binary(Bin) -> Bin;
+        _ -> exit({no_translation, unicode, latin1})
+    end;
+cast(Data, binary, latin1, unicode) when is_binary(Data); is_list(Data) ->
+    case catch unicode:characters_to_binary(Data, latin1, unicode) of
+        Bin when is_binary(Bin) -> Bin;
+        _ -> exit({no_translation, latin1, unicode})
+    end;
+cast(B, binary, unicode, unicode) when is_binary(B) ->
+    B;
+cast(L, binary, unicode, unicode) ->
+    case catch unicode:characters_to_binary(L, unicode) of
+        Bin when is_binary(Bin) -> Bin;
+        _ -> exit({no_translation, unicode, unicode})
+    end;
+cast(B, list, latin1, latin1) when is_binary(B) ->
+    binary_to_list(B);
+cast(L, list, latin1, latin1) ->
+    case catch erlang:iolist_to_binary(L) of
+        Bin when is_binary(Bin) -> binary_to_list(Bin);
+        _ -> exit({no_translation, latin1, latin1})
+    end;
+cast(Data, list, unicode, latin1) when is_binary(Data); is_list(Data) ->
+    case catch unicode:characters_to_list(Data, unicode) of
+        Chars when is_list(Chars) ->
+            [ case X of 
+                  High when High > 255 -> 
+                      exit({no_translation, unicode, latin1}); 
+                  Low -> 
+                      Low 
+              end || X <- Chars ];
+        _ ->
+            exit({no_translation, unicode, latin1})
+    end;
+cast(Data, list, latin1, unicode) when is_binary(Data); is_list(Data) ->
+    case catch unicode:characters_to_list(Data, latin1) of
+        Chars when is_list(Chars) -> Chars;
+        _ -> exit({no_translation, latin1, unicode})
+    end;
+cast(Data, list, unicode, unicode) when is_binary(Data); is_list(Data) ->
+    case catch unicode:characters_to_list(Data, unicode) of
+        Chars when is_list(Chars) -> Chars;
+        _ -> exit({no_translation, unicode, unicode})
+    end.
+
+wrap_characters_to_binary(Chars, unicode, latin1) ->
+    case catch unicode:characters_to_binary(Chars, unicode, latin1) of
+        Bin when is_binary(Bin) ->
+            Bin;
+        _ ->
+            case catch unicode:characters_to_list(Chars, unicode) of
+                L when is_list(L) ->
+                    list_to_binary(
+                      [ case X of
+                            High when High > 255 ->
+                                ["\\x{",erlang:integer_to_list(X, 16),$}];
+                            Low ->
+                                Low
+                        end || X <- L ]);
+                _ ->
+                    error
+            end
+    end;
+wrap_characters_to_binary(Bin, From, From) when is_binary(Bin) ->
+    Bin;
+wrap_characters_to_binary(Chars, From, To) ->
+    case catch unicode:characters_to_binary(Chars, From, To) of
+        Bin when is_binary(Bin) ->
+            Bin;
+        _ ->
+            error
+    end.
+