diff options
Diffstat (limited to 'lib/kernel/src/user_drv.erl')
| -rw-r--r-- | lib/kernel/src/user_drv.erl | 1458 |
1 files changed, 864 insertions, 594 deletions
diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index fa7687bf2a..25ebcbdd68 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. 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. @@ -19,591 +19,890 @@ %% -module(user_drv). -%% Basic interface to a port. - --export([start/0,start/1,start/2,start/3,server/2,server/3]). - --export([interfaces/1]). +%% Basic interface to stdin/stdout. +%% +%% This is responsible for a couple of things: +%% - Dispatching I/O messages when erl is running +%% The messages are listed in the type message/0. +%% - Any data received from the terminal is sent to the current group like this: +%% `{DrvPid :: pid(), {data, UnicodeCharacters :: list()}}` +%% - It serves as the job control manager (i.e. what happens when you type ^G) +%% - Starts potential -remsh sessions to other nodes +%% +-type message() :: + %% I/O requests that modify the terminal + {Sender :: pid(), request()} | + %% Query the server of the current dimensions of the terminal. + %% `Sender` will be sent the message: + %% `{DrvPid :: pid(), tty_geometry, {Width :: integer(), Height :: integer()}}` + {Sender :: pid(), tty_geometry} | + %% Query the server if it supports unicode characters + %% `Sender` will be sent the message: + %% `{DrvPid :: pid(), get_unicode_state, SupportUnicode :: boolean()}` + {Sender :: pid(), get_unicode_state} | + %% Change whether the server supports unicode characters or not. The reply + %% contains the previous unicode state. + %% `Sender` will be sent the message: + %% `{DrvPid :: pid(), set_unicode_state, SupportedUnicode :: boolean()}` + {Sender :: pid(), set_unicode_state, boolean()}. +-type request() :: + %% Put characters at current cursor position, + %% overwriting any characters it encounters. + {put_chars, unicode, binary()} | + %% Same as put_chars/3, but sends Reply to From when the characters are + %% guaranteed to have been written to the terminal + {put_chars_sync, unicode, binary(), {From :: pid(), Reply :: term()}} | + %% Put text in expansion area + {put_expand} | + {put_expand_no_trim} | + %% Move the cursor X characters left or right (negative is left) + {move_rel, -32768..32767} | + %% Move the cursor Y rows up or down (negative is up) + {move_line, -32768..32767} | + %% Move combo, helper to simplify some move operations + {move_combo, -32768..32767, -32768..32767, -32768..32767} | + %% Insert characters at current cursor position moving any + %% characters after the cursor. + {insert_chars, unicode, binary()} | + %% Delete X chars before or after the cursor adjusting any test remaining + %% to the right of the cursor. + {delete_chars, -32768..32767} | + %% Deletes the current prompt and expression + delete_line | + %% Delete after the cursor + delete_after_cursor | + %% Trigger a terminal "bell" + beep | + %% Clears the screen + clear | + %% Execute multiple request() actions + {requests, [request()]} | + %% Open external editor + {open_editor, string()} | + %% Redraws the current prompt and expression + redraw_prompt | + {redraw_prompt, string(), string(), tuple()} | + %% Clears the state, not touching the characters + new_prompt. + +-export_type([message/0]). +-export([start/0, start/1, start_shell/0, start_shell/1, whereis_group/0]). + +%% gen_statem state callbacks +-behaviour(gen_statem). +-export([init/3,server/3,switch_loop/3]). + +%% gen_statem callbacks +-export([init/1, callback_mode/0]). -include_lib("kernel/include/logger.hrl"). --define(OP_PUTC,0). --define(OP_MOVE,1). --define(OP_INSC,2). --define(OP_DELC,3). --define(OP_BEEP,4). --define(OP_PUTC_SYNC,5). -% Control op --define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). --define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). --define(CTRL_OP_GET_UNICODE_STATE, (101 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). --define(CTRL_OP_SET_UNICODE_STATE, (102 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). - -%% start() -%% start(ArgumentList) -%% start(PortName, Shell) -%% start(InPortName, OutPortName, Shell) -%% Start the user driver server. The arguments to start/1 are slightly -%% strange as this may be called both at start up from the command line -%% and explicitly from other code. - +-record(editor, { port :: port(), file :: file:name(), requester :: pid() }). +-record(state, { tty :: prim_tty:state() | undefined, + write :: reference() | undefined, + read :: reference() | undefined, + shell_started = new :: new | old | false, + editor :: #editor{} | undefined, + user :: pid(), + current_group :: pid() | undefined, + groups, queue }). + +-type shell() :: {module(), atom(), [term()]} | {node(), module(), atom(), [term()]}. +-type arguments() :: #{ initial_shell => noshell | shell() | + {remote, unicode:charlist()} | {remote, unicode:charlist(), {module(), atom(), [term()]}}, + input => boolean() }. + +%% Default line editing shell -spec start() -> pid(). +start() -> + case init:get_argument(remsh) of + {ok,[[Node]]} -> + start(#{ initial_shell => {remote, Node} }); + {ok,[[Node]|_]} -> + ?LOG_WARNING("Multiple -remsh given to erl, using the first, ~p", [Node]), + start(#{ initial_shell => {remote, Node} }); + E when E =:= error ; E =:= {ok,[[]]} -> + start(#{ }) + end. -start() -> %Default line editing shell - spawn(user_drv, server, ['tty_sl -c -e',{shell,start,[init]}]). +-spec start_shell() -> ok | {error, Reason :: term()}. +start_shell() -> + start_shell(#{ }). +-spec start_shell(arguments()) -> ok | {error, already_started}. +start_shell(Args) -> + gen_statem:call(?MODULE, {start_shell, Args}). + +-spec whereis_group() -> pid() | undefined. +whereis_group() -> + {dictionary, Dict} = + erlang:process_info(whereis(?MODULE), dictionary), + proplists:get_value(current_group, Dict). + +%% Backwards compatibility with pre OTP-26 for Elixir/LFE etc +-spec start(['tty_sl -c -e'| shell()]) -> pid(); + (arguments()) -> pid(). +start(['tty_sl -c -e', Shell]) -> + start(#{ initial_shell => Shell }); +start(Args) when is_map(Args) -> + case gen_statem:start({local, ?MODULE}, ?MODULE, Args, []) of + {ok, Pid} -> Pid; + {error, Reason} -> + {error, Reason} + end. -start([Pname]) -> - spawn(user_drv, server, [Pname,{shell,start,[init]}]); -start([Pname|Args]) -> - spawn(user_drv, server, [Pname|Args]); -start(Pname) -> - spawn(user_drv, server, [Pname,{shell,start,[init]}]). +callback_mode() -> state_functions. -start(Pname, Shell) -> - spawn(user_drv, server, [Pname,Shell]). +-spec init(arguments()) -> gen_statem:init_result(init). +init(Args) -> + process_flag(trap_exit, true), -start(Iname, Oname, Shell) -> - spawn(user_drv, server, [Iname,Oname,Shell]). + IsTTY = prim_tty:isatty(stdin) =:= true andalso prim_tty:isatty(stdout) =:= true, + StartShell = maps:get(initial_shell, Args, undefined) =/= noshell, + OldShell = maps:get(initial_shell, Args, undefined) =:= oldshell, + try + if + not IsTTY andalso StartShell; OldShell -> + error(enotsup); + IsTTY, StartShell -> + TTYState = prim_tty:init(#{}), + init_standard_error(TTYState, true), + {ok, init, {Args, #state{ user = start_user() } }, + {next_event, internal, TTYState}}; + true -> + TTYState = prim_tty:init(#{input => maps:get(input, Args, true), + tty => false}), + init_standard_error(TTYState, false), + {ok, init, {Args,#state{ user = start_user() } }, + {next_event, internal, TTYState}} + end + catch error:enotsup -> + %% This is thrown by prim_tty:init when + %% it could not start the terminal, + %% probably because TERM=dumb was set. + %% + %% The oldshell mode is important as it is + %% the mode used when running erlang in an + %% emacs buffer. + CatchTTYState = prim_tty:init(#{tty => false}), + init_standard_error(CatchTTYState, false), + {ok, init, {Args,#state{ shell_started = old, user = start_user() } }, + {next_event, internal, CatchTTYState}} + end. +%% Initialize standard_error +init_standard_error(TTY, NewlineCarriageReturn) -> + Encoding = case prim_tty:unicode(TTY) of + true -> unicode; + false -> latin1 + end, + ok = io:setopts(standard_error, [{encoding, Encoding}, + {onlcr, NewlineCarriageReturn}]). + +init(internal, TTYState, {Args, State = #state{ user = User }}) -> + + %% Cleanup ancestors so that observer looks nice + put('$ancestors',[User|get('$ancestors')]), + + #{ read := ReadHandle, write := WriteHandle } = prim_tty:handles(TTYState), + + NewState = State#state{ tty = TTYState, + read = ReadHandle, write = WriteHandle, + user = User, queue = {false, queue:new()}, + groups = gr_add_cur(gr_new(), User, {}) + }, + + case Args of + #{ initial_shell := noshell } -> + init_noshell(NewState); + #{ initial_shell := {remote, Node} } -> + InitialShell = {shell,start,[]}, + exit_on_remote_shell_error( + Node, InitialShell, init_remote_shell(NewState, Node, InitialShell)); + #{ initial_shell := {remote, Node, InitialShell} } -> + exit_on_remote_shell_error( + Node, InitialShell, init_remote_shell(NewState, Node, InitialShell)); + #{ initial_shell := oldshell } -> + old = State#state.shell_started, + init_local_shell(NewState, {shell,start,[]}); + #{ initial_shell := InitialShell } -> + init_local_shell(NewState, InitialShell); + _ -> + init_local_shell(NewState, {shell,start,[init]}) + end. -%% Return the pid of the active group process. -%% Note: We can't ask the user_drv process for this info since it -%% may be busy waiting for data from the port. +exit_on_remote_shell_error(RemoteNode, _, {error, noconnection}) -> + io:format(standard_error, "Could not connect to ~p\n", [RemoteNode]), + erlang:halt(1); +exit_on_remote_shell_error(RemoteNode, {M, _, _}, {error, Reason}) -> + io:format(standard_error, "Could not load ~p on ~p (~p)\n", [RemoteNode, M, Reason]), + erlang:halt(1); +exit_on_remote_shell_error(_, _, Result) -> + Result. + +%% We have been started with -noshell. In this mode the current_group is +%% the `user` group process. +init_noshell(State) -> + init_shell(State#state{ shell_started = false }, ""). + +init_remote_shell(State, Node, {M, F, A}) -> + + case net_kernel:get_state() of + #{ started := no } -> + {ok, _} = net_kernel:start([undefined, shortnames]), + ok; + _ -> + ok + end, --spec interfaces(pid()) -> [{'current_group', pid()}]. + LocalNode = + case net_kernel:get_state() of + #{ name_type := dynamic } -> + net_kernel:nodename(); + #{ name_type := static } -> + node() + end, + + RemoteNode = + case string:find(Node,"@") of + nomatch -> + list_to_atom(Node ++ string:find(atom_to_list(LocalNode),"@")); + _ -> + list_to_atom(Node) + end, + + case net_kernel:connect_node(RemoteNode) of + true -> + + case erpc:call(RemoteNode, code, ensure_loaded, [M]) of + {error, Reason} when Reason =/= embedded -> + {error, Reason}; + _ -> + + %% Setup correct net tick times + case erpc:call(RemoteNode, net_kernel, get_net_ticktime, []) of + {ongoing_change_to, NetTickTime} -> + _ = net_kernel:set_net_ticktime(NetTickTime), + ok; + NetTickTime -> + _ = net_kernel:set_net_ticktime(NetTickTime), + ok + end, -interfaces(UserDrv) -> - case process_info(UserDrv, dictionary) of - {dictionary,Dict} -> - case lists:keysearch(current_group, 1, Dict) of - {value,Gr={_,Group}} when is_pid(Group) -> - [Gr]; - _ -> - [] - end; - _ -> - [] + RShell = {RemoteNode, M, F, A}, + + %% We fetch the shell slogan from the remote node + Slogan = + case erpc:call(RemoteNode, application, get_env, + [stdlib, shell_slogan, + erpc:call(RemoteNode, erlang, system_info, [system_version])]) of + Fun when is_function(Fun, 0) -> + erpc:call(RemoteNode, Fun); + SloganEnv -> + SloganEnv + end, + + Group = group:start(self(), RShell, + [{echo,State#state.shell_started =:= new}] ++ + group_opts(RemoteNode)), + + Gr = gr_add_cur(State#state.groups, Group, RShell), + + init_shell(State#state{ groups = Gr }, [Slogan,$\n]) + end; + false -> + {error, noconnection} end. -%% server(Pid, Shell) -%% server(Pname, Shell) -%% server(Iname, Oname, Shell) -%% The initial calls to run the user driver. These start the port(s) -%% then call server1/3 to set everything else up. - -server(Pid, Shell) when is_pid(Pid) -> - server1(Pid, Pid, Shell); -server(Pname, Shell) -> - process_flag(trap_exit, true), - case catch open_port({spawn,Pname}, [eof]) of - {'EXIT', _} -> - %% Let's try a dumb user instead - user:start(); - Port -> - server1(Port, Port, Shell) - end. +init_local_shell(State, InitialShell) -> + Slogan = + case application:get_env( + stdlib, shell_slogan, + fun() -> erlang:system_info(system_version) end) of + Fun when is_function(Fun, 0) -> + Fun(); + SloganEnv -> + SloganEnv + end, -server(Iname, Oname, Shell) -> - process_flag(trap_exit, true), - case catch open_port({spawn,Iname}, [eof]) of - {'EXIT', _} -> %% It might be a dumb terminal lets start dumb user - user:start(); - Iport -> - Oport = open_port({spawn,Oname}, [eof]), - server1(Iport, Oport, Shell) - end. + Gr = gr_add_cur(State#state.groups, + group:start(self(), InitialShell, + group_opts() ++ [{echo,State#state.shell_started =:= new}]), + InitialShell), -server1(Iport, Oport, Shell) -> - put(eof, false), - %% Start user and initial shell. - User = start_user(), - Gr1 = gr_add_cur(gr_new(), User, {}), - - {Curr,Shell1} = - case init:get_argument(remsh) of - {ok,[[Node]]} -> - ANode = - if - node() =:= nonode@nohost -> - %% We try to connect to the node if the current node is not - %% a distributed node yet. If this succeeds it means that we - %% are running using "-sname undefined". - _ = net_kernel:start([undefined, shortnames]), - NodeName = append_hostname(Node, net_kernel:nodename()), - case net_kernel:connect_node(NodeName) of - true -> - NodeName; - _Else -> - ?LOG_ERROR("Could not connect to ~p",[Node]) - end; - true -> - append_hostname(Node, node()) - end, + init_shell(State#state{ groups = Gr }, [Slogan,$\n]). - RShell = {ANode,shell,start,[]}, - RGr = group:start(self(), RShell, rem_sh_opts(ANode)), - {RGr,RShell}; - E when E =:= error ; E =:= {ok,[[]]} -> - {group:start(self(), Shell),Shell} - end, +init_shell(State, Slogan) -> + init_standard_error(State#state.tty, State#state.shell_started =:= new), + Curr = gr_cur_pid(State#state.groups), put(current_group, Curr), - Gr = gr_add_cur(Gr1, Curr, Shell1), - %% Print some information. - io_request({put_chars, unicode, - flatten(io_lib:format("~ts\n", - [erlang:system_info(system_version)]))}, - Iport, Oport), - - %% Enter the server loop. - server_loop(Iport, Oport, Curr, User, Gr, {false, queue:new()}). - -append_hostname(Node, LocalNode) -> - case string:find(Node,"@") of - nomatch -> - list_to_atom(Node ++ string:find(atom_to_list(LocalNode),"@")); - _ -> - list_to_atom(Node) - end. - -rem_sh_opts(Node) -> - [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. + {next_state, server, State#state{ current_group = gr_cur_pid(State#state.groups) }, + {next_event, info, + {gr_cur_pid(State#state.groups), + {put_chars, unicode, + unicode:characters_to_binary(io_lib:format("~ts", [Slogan]))}}}}. %% start_user() %% Start a group leader process and register it as 'user', unless, %% of course, a 'user' already exists. - start_user() -> - case whereis(user_drv) of - undefined -> - register(user_drv, self()); - _ -> - ok - end, case whereis(user) of undefined -> - User = group:start(self(), {}), + User = group:start(self(), {}, [{echo,false}]), register(user, User), User; User -> User end. - -server_loop(Iport, Oport, User, Gr, IOQueue) -> - Curr = gr_cur_pid(Gr), - put(current_group, Curr), - server_loop(Iport, Oport, Curr, User, Gr, IOQueue). - -server_loop(Iport, Oport, Curr, User, Gr, {Resp, IOQ} = IOQueue) -> - receive - {Iport,{data,Bs}} -> - BsBin = list_to_binary(Bs), - Unicode = unicode:characters_to_list(BsBin,utf8), - port_bytes(Unicode, Iport, Oport, Curr, User, Gr, IOQueue); - {Iport,eof} -> - Curr ! {self(),eof}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - - %% We always handle geometry and unicode requests - {Requester,tty_geometry} -> - Requester ! {self(),tty_geometry,get_tty_geometry(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {Requester,get_unicode_state} -> - Requester ! {self(),get_unicode_state,get_unicode_state(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {Requester,set_unicode_state, Bool} -> - Requester ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - - Req when element(1,Req) =:= User orelse element(1,Req) =:= Curr, - tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> - %% We match {User|Curr,_}|{User|Curr,_,_} - NewQ = handle_req(Req, Iport, Oport, IOQueue), - server_loop(Iport, Oport, Curr, User, Gr, NewQ); - {Oport,ok} -> - %% We get this ok from the port, in io_request we store - %% info about where to send reply at head of queue - {Origin,Reply} = Resp, - Origin ! {reply,Reply}, - NewQ = handle_req(next, Iport, Oport, {false, IOQ}), - server_loop(Iport, Oport, Curr, User, Gr, NewQ); - {'EXIT',Iport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {'EXIT',Oport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {'EXIT',User,shutdown} -> % force data to port - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {'EXIT',User,_R} -> % keep 'user' alive - NewU = start_user(), - server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}), IOQueue); - {'EXIT',Pid,R} -> % shell and group leader exit - case gr_cur_pid(Gr) of - Pid when R =/= die , - R =/= terminated -> % current shell exited - if R =/= normal -> - io_requests([{put_chars,unicode,"*** ERROR: "}], Iport, Oport); - true -> % exit not caused by error - io_requests([{put_chars,unicode,"*** "}], Iport, Oport) - end, - io_requests([{put_chars,unicode,"Shell process terminated! "}], Iport, Oport), - Gr1 = gr_del_pid(Gr, Pid), - case gr_get_info(Gr, Pid) of - {Ix,{shell,start,Params}} -> % 3-tuple == local shell - io_requests([{put_chars,unicode,"***\n"}], Iport, Oport), - %% restart group leader and shell, same index - Pid1 = group:start(self(), {shell,start,Params}), - {ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, Pid1, - {shell,start,Params}), Ix), - put(current_group, Pid1), - server_loop(Iport, Oport, Pid1, User, Gr2, IOQueue); - _ -> % remote shell - io_requests([{put_chars,unicode,"(^G to start new job) ***\n"}], - Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr1, IOQueue) - end; - _ -> % not current, just remove it - server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue) - end; - {Requester, {put_chars_sync, _, _, Reply}} -> - %% We need to ack the Req otherwise originating process will hang forever - %% Do discard the output to non visible shells (as was done previously) - Requester ! {reply, Reply}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - _X -> - %% Ignore unknown messages. - server_loop(Iport, Oport, Curr, User, Gr, IOQueue) - end. -handle_req(next,Iport,Oport,{false,IOQ}=IOQueue) -> - case queue:out(IOQ) of - {empty,_} -> - IOQueue; - {{value,{Origin,Req}},ExecQ} -> - case io_request(Req, Iport, Oport) of - ok -> - handle_req(next,Iport,Oport,{false,ExecQ}); - Reply -> - {{Origin,Reply}, ExecQ} +server({call, From}, {start_shell, Args}, + State = #state{ tty = TTY, shell_started = false }) -> + IsTTY = prim_tty:isatty(stdin) =:= true andalso prim_tty:isatty(stdout) =:= true, + StartShell = maps:get(initial_shell, Args, undefined) =/= noshell, + OldShell = maps:get(initial_shell, Args, undefined) =:= oldshell, + NewState = + try + if + not IsTTY andalso StartShell; OldShell -> + error(enotsup); + IsTTY, StartShell -> + NewTTY = prim_tty:reinit(TTY, #{ }), + State#state{ tty = NewTTY, + shell_started = new }; + true -> + NewTTY = prim_tty:reinit(TTY, #{ tty => false }), + State#state{ tty = NewTTY, shell_started = false } end + catch error:enotsup -> + NewTTYState = prim_tty:reinit(TTY, #{ tty => false }), + State#state{ tty = NewTTYState, shell_started = old } + end, + #{ read := ReadHandle, write := WriteHandle } = prim_tty:handles(NewState#state.tty), + NewHandleState = NewState#state { + read = ReadHandle, + write = WriteHandle + }, + {Result, Reply} + = case maps:get(initial_shell, Args, undefined) of + noshell -> + {init_noshell(NewHandleState), ok}; + {remote, Node} -> + case init_remote_shell(NewHandleState, Node, {shell, start, []}) of + {error, _} = Error -> + {init_noshell(NewHandleState), Error}; + R -> + {R, ok} + end; + {remote, Node, InitialShell} -> + case init_remote_shell(NewHandleState, Node, InitialShell) of + {error, _} = Error -> + {init_noshell(NewHandleState), Error}; + R -> + {R, ok} + end; + undefined -> + case NewHandleState#state.shell_started of + old -> + {init_local_shell(NewHandleState, {shell,start,[]}), ok}; + new -> + {init_local_shell(NewHandleState, {shell,start,[init]}), ok}; + false -> + %% This can never happen, but dialyzer complains so we add + %% this clause. + {keep_state_and_data, ok} + end; + InitialShell -> + {init_local_shell(NewHandleState, InitialShell), ok} + end, + gen_statem:reply(From, Reply), + Result; +server({call, From}, {start_shell, _Args}, _State) -> + gen_statem:reply(From, {error, already_started}), + keep_state_and_data; +server(info, {ReadHandle,{data,UTF8Binary}}, State = #state{ read = ReadHandle }) + when State#state.current_group =:= State#state.user -> + State#state.current_group ! + {self(), {data, unicode:characters_to_list(UTF8Binary, utf8)}}, + keep_state_and_data; +server(info, {ReadHandle,{data,UTF8Binary}}, State = #state{ read = ReadHandle }) -> + case contains_ctrl_g_or_ctrl_c(UTF8Binary) of + ctrl_g -> {next_state, switch_loop, State, {next_event, internal, init}}; + ctrl_c -> + case gr_get_info(State#state.groups, State#state.current_group) of + undefined -> ok; + _ -> exit(State#state.current_group, interrupt) + end, + keep_state_and_data; + none -> + State#state.current_group ! + {self(), {data, unicode:characters_to_list(UTF8Binary, utf8)}}, + keep_state_and_data end; -handle_req(Msg,Iport,Oport,{false,IOQ}=IOQueue) -> - empty = queue:peek(IOQ), - {Origin,Req} = Msg, - case io_request(Req, Iport, Oport) of - ok -> - IOQueue; - Reply -> - {{Origin,Reply}, IOQ} - end; -handle_req(Msg,_Iport,_Oport,{Resp, IOQ}) -> - %% All requests are queued when we have outstanding sync put_chars - {Resp, queue:in(Msg,IOQ)}. - -%% port_bytes(Bytes, InPort, OutPort, CurrentProcess, UserProcess, Group) -%% Check the Bytes from the port to see if it contains a ^G. If so, -%% either escape to switch_loop or restart the shell. Otherwise send -%% the bytes to Curr. - -port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr, IOQueue) -> - handle_escape(Iport, Oport, User, Gr, IOQueue); - -port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr, IOQueue) -> - interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue); - -port_bytes([B], Iport, Oport, Curr, User, Gr, IOQueue) -> - Curr ! {self(),{data,[B]}}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); -port_bytes(Bs, Iport, Oport, Curr, User, Gr, IOQueue) -> - case member($\^G, Bs) of - true -> - handle_escape(Iport, Oport, User, Gr, IOQueue); - false -> - Curr ! {self(),{data,Bs}}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue) - end. - -interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue) -> - case gr_get_info(Gr, Curr) of - undefined -> - ok; % unknown - _ -> - exit(Curr, interrupt) +server(info, {ReadHandle,eof}, State = #state{ read = ReadHandle }) -> + State#state.current_group ! {self(), eof}, + keep_state_and_data; +server(info,{ReadHandle,{signal,Signal}}, State = #state{ tty = TTYState, read = ReadHandle }) -> + {keep_state, State#state{ tty = prim_tty:handle_signal(TTYState, Signal) }}; + +server(info, {Requester, tty_geometry}, #state{ tty = TTYState }) -> + case prim_tty:window_size(TTYState) of + {ok, Geometry} -> + Requester ! {self(), tty_geometry, Geometry}, + ok; + Error -> + Requester ! {self(), tty_geometry, Error}, + ok end, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue). - -handle_escape(Iport, Oport, User, Gr, IOQueue) -> - case application:get_env(stdlib, shell_esc) of - {ok,abort} -> - Pid = gr_cur_pid(Gr), - exit(Pid, die), + keep_state_and_data; +server(info, {Requester, get_unicode_state}, #state{ tty = TTYState }) -> + Requester ! {self(), get_unicode_state, prim_tty:unicode(TTYState) }, + keep_state_and_data; +server(info, {Requester, set_unicode_state, Bool}, #state{ tty = TTYState } = State) -> + OldUnicode = prim_tty:unicode(TTYState), + NewTTYState = prim_tty:unicode(TTYState, Bool), + ok = io:setopts(standard_error,[{encoding, if Bool -> unicode; true -> latin1 end}]), + Requester ! {self(), set_unicode_state, OldUnicode}, + {keep_state, State#state{ tty = NewTTYState }}; +server(info, {Requester, get_terminal_state}, _State) -> + Requester ! {self(), get_terminal_state, prim_tty:isatty(stdout) }, + keep_state_and_data; +server(info, {Requester, {open_editor, Buffer}}, #state{tty = TTYState } = State) -> + case open_editor(TTYState, Buffer) of + false -> + Requester ! {self(), {editor_data, Buffer}}, + keep_state_and_data; + {EditorPort, TmpPath} -> + {keep_state, State#state{ editor = #editor{ port = EditorPort, + file = TmpPath, + requester = Requester }}} + end; +server(info, Req, State = #state{ user = User, current_group = Curr, editor = undefined }) + when element(1,Req) =:= User orelse element(1,Req) =:= Curr, + tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> + %% We match {User|Curr,_}|{User|Curr,_,_} + {NewTTYState, NewQueue} = handle_req(Req, State#state.tty, State#state.queue), + {keep_state, State#state{ tty = NewTTYState, queue = NewQueue }}; +server(info, {WriteRef, ok}, State = #state{ write = WriteRef, + queue = {{Origin, MonitorRef, Reply}, IOQ} }) -> + %% We get this ok from the user_drv_writer, in io_request we store + %% info about where to send reply at head of queue + Origin ! {reply, Reply, ok}, + erlang:demonitor(MonitorRef, [flush]), + {NewTTYState, NewQueue} = handle_req(next, State#state.tty, {false, IOQ}), + {keep_state, State#state{ tty = NewTTYState, queue = NewQueue }}; +server(info, {'DOWN', MonitorRef, _, _, Reason}, + #state{ queue = {{Origin, MonitorRef, Reply}, _IOQ} }) -> + %% The writer process died, we send the correct error to the caller and + %% then stop this process. This will bring down all linked groups (including 'user'). + %% All writes from now on will throw badarg terminated. + Origin ! {reply, Reply, {error, Reason}}, + ?LOG_INFO("Failed to write to standard out (~p)", [Reason]), + stop; +server(info,{Requester, {put_chars_sync, _, _, Reply}}, _State) -> + %% This is a sync request from an unknown or inactive group. + %% We need to ack the Req otherwise originating process will hang forever. + %% We discard the output to non visible shells + Requester ! {reply, Reply, ok}, + keep_state_and_data; + +server(info,{'EXIT',User, shutdown}, #state{ user = User }) -> + keep_state_and_data; +server(info,{'EXIT',User, _Reason}, State = #state{ user = User }) -> + NewUser = start_user(), + {keep_state, State#state{ user = NewUser, + groups = gr_set_num(State#state.groups, 1, NewUser, {})}}; +server(info, {'EXIT', EditorPort, _R}, + State = #state{tty = TTYState, + editor = #editor{ requester = Requester, + port = EditorPort, + file = PathTmp}}) -> + {ok, Content} = file:read_file(PathTmp), + _ = file:del_dir_r(PathTmp), + Unicode = case unicode:characters_to_list(Content,unicode) of + {error, _, _} -> unicode:characters_to_list( + unicode:characters_to_list(Content,latin1), unicode); + U -> U + end, + Requester ! {self(), {editor_data, string:chomp(Unicode)}}, + ok = prim_tty:enable_reader(TTYState), + {keep_state, State#state{editor = undefined}}; +server(info,{'EXIT', Group, Reason}, State) -> % shell and group leader exit + case gr_cur_pid(State#state.groups) of + Group when Reason =/= die, Reason =/= terminated -> % current shell exited + Reqs = [if + Reason =/= normal -> + {put_chars,unicode,<<"*** ERROR: ">>}; + true -> % exit not caused by error + {put_chars,unicode,<<"*** ">>} + end, + {put_chars,unicode,<<"Shell process terminated! ">>}], + Gr1 = gr_del_pid(State#state.groups, Group), + case gr_get_info(State#state.groups, Group) of + {Ix,{shell,start,Params}} -> % 3-tuple == local shell + NewTTyState = io_requests(Reqs ++ [{put_chars,unicode,<<"***\n">>}], + State#state.tty), + %% restart group leader and shell, same index + NewGroup = group:start(self(), {shell,start,Params}), + {ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, NewGroup, + {shell,start,Params}), Ix), + {keep_state, State#state{ tty = NewTTyState, + current_group = NewGroup, + groups = Gr2 }}; + _ -> % remote shell + NewTTYState = io_requests( + Reqs ++ [{put_chars,unicode,<<"(^G to start new job) ***\n">>}], + State#state.tty), + {keep_state, State#state{ tty = NewTTYState, groups = Gr1 }} + end; + _ -> % not current, just remove it + {keep_state, State#state{ groups = gr_del_pid(State#state.groups, Group) }} + end; +server(_, _, _) -> + keep_state_and_data. + +contains_ctrl_g_or_ctrl_c(<<$\^G,_/binary>>) -> + ctrl_g; +contains_ctrl_g_or_ctrl_c(<<$\^C,_/binary>>) -> + ctrl_c; +contains_ctrl_g_or_ctrl_c(<<_/utf8,T/binary>>) -> + contains_ctrl_g_or_ctrl_c(T); +contains_ctrl_g_or_ctrl_c(<<>>) -> + none. + +switch_loop(internal, init, State) -> + case application:get_env(stdlib, shell_esc, jcl) of + abort -> + CurrGroup = gr_cur_pid(State#state.groups), + exit(CurrGroup, die), Gr1 = - case gr_get_info(Gr, Pid) of - {_Ix,{}} -> % no shell - Gr; + case gr_get_info(State#state.groups, CurrGroup) of + {_Ix,{}} -> % no shell + State#state.groups; _ -> - receive {'EXIT',Pid,_} -> - gr_del_pid(Gr, Pid) + receive {'EXIT',CurrGroup,_} -> + gr_del_pid(State#state.groups, CurrGroup) after 1000 -> - Gr + State#state.groups end end, - Pid1 = group:start(self(), {shell,start,[]}), - io_request({put_chars,unicode,"\n"}, Iport, Oport), - server_loop(Iport, Oport, User, - gr_add_cur(Gr1, Pid1, {shell,start,[]}), IOQueue); - - _ -> % {ok,jcl} | undefined - io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport), + NewGroup = group:start(self(), {shell,start,[]}), + NewTTYState = io_requests([{put_chars,unicode,<<"\n">>}], State#state.tty), + {next_state, server, + State#state{ tty = NewTTYState, + groups = gr_add_cur(Gr1, NewGroup, {shell,start,[]})}}; + jcl -> + NewTTYState = + io_requests([{put_chars,unicode,<<"\nUser switch command (type h for help)\n">>}], + State#state.tty), %% init edlin used by switch command and have it copy the %% text buffer from current group process - edlin:init(gr_cur_pid(Gr)), - server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue) - end. - -switch_loop(Iport, Oport, Gr) -> - Line = get_line(edlin:start(" --> "), Iport, Oport), - switch_cmd(erl_scan:string(Line), Iport, Oport, Gr). - -switch_cmd({ok,[{atom,_,c},{integer,_,I}],_}, Iport, Oport, Gr0) -> - case gr_set_cur(Gr0, I) of - {ok,Gr} -> Gr; - undefined -> unknown_group(Iport, Oport, Gr0) + edlin:init(gr_cur_pid(State#state.groups)), + {keep_state, State#state{ tty = NewTTYState }, + {next_event, internal, line}} end; -switch_cmd({ok,[{atom,_,c}],_}, Iport, Oport, Gr) -> - case gr_get_info(Gr, gr_cur_pid(Gr)) of - undefined -> - unknown_group(Iport, Oport, Gr); - _ -> - Gr +switch_loop(internal, line, State) -> + {more_chars, Cont, Rs} = edlin:start(" --> "), + {keep_state, {Cont, State#state{ tty = io_requests(Rs, State#state.tty) }}}; +switch_loop(internal, {line, Line}, State) -> + case erl_scan:string(Line) of + {ok, Tokens, _} -> + case switch_cmd(Tokens, State#state.groups) of + {ok, Groups} -> + Curr = gr_cur_pid(Groups), + put(current_group, Curr), + Curr ! {self(), activate}, + {next_state, server, + State#state{ current_group = Curr, groups = Groups }}; + {retry, Requests} -> + {keep_state, State#state{ tty = io_requests(Requests, State#state.tty) }, + {next_event, internal, line}}; + {retry, Requests, Groups} -> + Curr = gr_cur_pid(Groups), + put(current_group, Curr), + {keep_state, State#state{ + tty = io_requests(Requests, State#state.tty), + current_group = Curr, + groups = Groups }, + {next_event, internal, line}} + end; + {error, _, _} -> + NewTTYState = + io_requests([{put_chars,unicode,<<"Illegal input\n">>}], State#state.tty), + {keep_state, State#state{ tty = NewTTYState }, + {next_event, internal, line}} end; -switch_cmd({ok,[{atom,_,i},{integer,_,I}],_}, Iport, Oport, Gr) -> +switch_loop(info,{ReadHandle,{data,Cs}}, {Cont, #state{ read = ReadHandle } = State}) -> + case edlin:edit_line(unicode:characters_to_list(Cs), Cont) of + {done,{[Line],_,_},_Rest, Rs} -> + {keep_state, State#state{ tty = io_requests(Rs, State#state.tty) }, + {next_event, internal, {line, Line}}}; + {undefined,_Char,MoreCs,NewCont,Rs} -> + {keep_state, + {NewCont, State#state{ tty = io_requests(Rs ++ [beep], State#state.tty)}}, + {next_event, info, {ReadHandle,{data,MoreCs}}}}; + {more_chars,NewCont,Rs} -> + {keep_state, + {NewCont, State#state{ tty = io_requests(Rs, State#state.tty)}}}; + {blink,NewCont,Rs} -> + {keep_state, + {NewCont, State#state{ tty = io_requests(Rs, State#state.tty)}}, + 1000} + end; +switch_loop(timeout, _, {_Cont, State}) -> + {keep_state_and_data, + {next_event, info, {State#state.read,{data,[]}}}}; +switch_loop(info, _Unknown, _State) -> + {keep_state_and_data, postpone}. + +switch_cmd([{atom,_,Key},{Type,_,Value}], Gr) + when Type =:= atom; Type =:= integer -> + switch_cmd({Key, Value}, Gr); +switch_cmd([{atom,_,Key},{atom,_,V1},{atom,_,V2}], Gr) -> + switch_cmd({Key, V1, V2}, Gr); +switch_cmd([{atom,_,Key}], Gr) -> + switch_cmd(Key, Gr); +switch_cmd([{'?',_}], Gr) -> + switch_cmd(h, Gr); + +switch_cmd(Cmd, Gr) when Cmd =:= c; Cmd =:= i; Cmd =:= k -> + switch_cmd({Cmd, gr_cur_index(Gr)}, Gr); +switch_cmd({c, I}, Gr0) -> + case gr_set_cur(Gr0, I) of + {ok,Gr} -> {ok, Gr}; + undefined -> unknown_group() + end; +switch_cmd({i, I}, Gr) -> case gr_get_num(Gr, I) of {pid,Pid} -> exit(Pid, interrupt), - switch_loop(Iport, Oport, Gr); + {retry, []}; undefined -> - unknown_group(Iport, Oport, Gr) + unknown_group() end; -switch_cmd({ok,[{atom,_,i}],_}, Iport, Oport, Gr) -> - Pid = gr_cur_pid(Gr), - case gr_get_info(Gr, Pid) of - undefined -> - unknown_group(Iport, Oport, Gr); - _ -> - exit(Pid, interrupt), - switch_loop(Iport, Oport, Gr) - end; -switch_cmd({ok,[{atom,_,k},{integer,_,I}],_}, Iport, Oport, Gr) -> +switch_cmd({k, I}, Gr) -> case gr_get_num(Gr, I) of {pid,Pid} -> exit(Pid, die), case gr_get_info(Gr, Pid) of {_Ix,{}} -> % no shell - switch_loop(Iport, Oport, Gr); + retry; _ -> - Gr1 = - receive {'EXIT',Pid,_} -> - gr_del_pid(Gr, Pid) - after 1000 -> - Gr - end, - switch_loop(Iport, Oport, Gr1) + receive {'EXIT',Pid,_} -> + {retry,[],gr_del_pid(Gr, Pid)} + after 1000 -> + {retry,[],Gr} + end end; undefined -> - unknown_group(Iport, Oport, Gr) + unknown_group() end; -switch_cmd({ok,[{atom,_,k}],_}, Iport, Oport, Gr) -> - Pid = gr_cur_pid(Gr), - Info = gr_get_info(Gr, Pid), - case Info of - undefined -> - unknown_group(Iport, Oport, Gr); - {_Ix,{}} -> % no shell - switch_loop(Iport, Oport, Gr); - _ -> - exit(Pid, die), - Gr1 = - receive {'EXIT',Pid,_} -> - gr_del_pid(Gr, Pid) - after 1000 -> - Gr - end, - switch_loop(Iport, Oport, Gr1) - end; -switch_cmd({ok,[{atom,_,j}],_}, Iport, Oport, Gr) -> - io_requests(gr_list(Gr), Iport, Oport), - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,[{atom,_,s},{atom,_,Shell}],_}, Iport, Oport, Gr0) -> +switch_cmd(j, Gr) -> + {retry, gr_list(Gr)}; +switch_cmd({s, Shell}, Gr0) when is_atom(Shell) -> Pid = group:start(self(), {Shell,start,[]}), Gr = gr_add_cur(Gr0, Pid, {Shell,start,[]}), - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,[{atom,_,s}],_}, Iport, Oport, Gr0) -> - Pid = group:start(self(), {shell,start,[]}), - Gr = gr_add_cur(Gr0, Pid, {shell,start,[]}), - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,[{atom,_,r}],_}, Iport, Oport, Gr0) -> + {retry, [], Gr}; +switch_cmd(s, Gr) -> + switch_cmd({s, shell}, Gr); +switch_cmd(r, Gr0) -> case is_alive() of true -> Node = pool:get_node(), - Pid = group:start(self(), {Node,shell,start,[]}), + Pid = group:start(self(), {Node,shell,start,[]}, group_opts(Node)), Gr = gr_add_cur(Gr0, Pid, {Node,shell,start,[]}), - switch_loop(Iport, Oport, Gr); + {retry, [], Gr}; false -> - io_request({put_chars,unicode,"Not alive\n"}, Iport, Oport), - switch_loop(Iport, Oport, Gr0) + {retry, [{put_chars,unicode,<<"Node is not alive\n">>}]} + end; +switch_cmd({r, Node}, Gr) when is_atom(Node)-> + switch_cmd({r, Node, shell}, Gr); +switch_cmd({r,Node,Shell}, Gr0) when is_atom(Node), is_atom(Shell) -> + case is_alive() of + true -> + Pid = group:start(self(), {Node,Shell,start,[]}, group_opts(Node)), + Gr = gr_add_cur(Gr0, Pid, {Node,Shell,start,[]}), + {retry, [], Gr}; + false -> + {retry, [{put_chars,unicode,"Node is not alive\n"}]} end; -switch_cmd({ok,[{atom,_,r},{atom,_,Node}],_}, Iport, Oport, Gr0) -> - Pid = group:start(self(), {Node,shell,start,[]}), - Gr = gr_add_cur(Gr0, Pid, {Node,shell,start,[]}), - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,[{atom,_,r},{atom,_,Node},{atom,_,Shell}],_}, - Iport, Oport, Gr0) -> - Pid = group:start(self(), {Node,Shell,start,[]}), - Gr = gr_add_cur(Gr0, Pid, {Node,Shell,start,[]}), - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,[{atom,_,q}],_}, Iport, Oport, Gr) -> + +switch_cmd(q, _Gr) -> case erlang:system_info(break_ignored) of true -> % noop - io_request({put_chars,unicode,"Unknown command\n"}, Iport, Oport), - switch_loop(Iport, Oport, Gr); + {retry, [{put_chars,unicode,<<"Unknown command\n">>}]}; false -> halt() end; -switch_cmd({ok,[{atom,_,h}],_}, Iport, Oport, Gr) -> - list_commands(Iport, Oport), - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,[{'?',_}],_}, Iport, Oport, Gr) -> - list_commands(Iport, Oport), - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,[],_}, Iport, Oport, Gr) -> - switch_loop(Iport, Oport, Gr); -switch_cmd({ok,_Ts,_}, Iport, Oport, Gr) -> - io_request({put_chars,unicode,"Unknown command\n"}, Iport, Oport), - switch_loop(Iport, Oport, Gr); -switch_cmd(_Ts, Iport, Oport, Gr) -> - io_request({put_chars,unicode,"Illegal input\n"}, Iport, Oport), - switch_loop(Iport, Oport, Gr). - -unknown_group(Iport, Oport, Gr) -> - io_request({put_chars,unicode,"Unknown job\n"}, Iport, Oport), - switch_loop(Iport, Oport, Gr). - -list_commands(Iport, Oport) -> +switch_cmd(h, _Gr) -> + {retry, list_commands()}; +switch_cmd([], _Gr) -> + {retry,[]}; +switch_cmd(_Ts, _Gr) -> + {retry, [{put_chars,unicode,<<"Unknown command\n">>}]}. + +unknown_group() -> + {retry,[{put_chars,unicode,<<"Unknown job\n">>}]}. + +list_commands() -> QuitReq = case erlang:system_info(break_ignored) of - true -> + true -> []; false -> - [{put_chars, unicode," q - quit erlang\n"}] + [{put_chars, unicode,<<" q - quit erlang\n">>}] end, - io_requests([{put_chars, unicode," c [nn] - connect to job\n"}, - {put_chars, unicode," i [nn] - interrupt job\n"}, - {put_chars, unicode," k [nn] - kill job\n"}, - {put_chars, unicode," j - list all jobs\n"}, - {put_chars, unicode," s [shell] - start local shell\n"}, - {put_chars, unicode," r [node [shell]] - start remote shell\n"}] ++ - QuitReq ++ - [{put_chars, unicode," ? | h - this message\n"}], - Iport, Oport). - -get_line({done,Line,_Rest,Rs}, Iport, Oport) -> - io_requests(Rs, Iport, Oport), - Line; -get_line({undefined,_Char,Cs,Cont,Rs}, Iport, Oport) -> - io_requests(Rs, Iport, Oport), - io_request(beep, Iport, Oport), - get_line(edlin:edit_line(Cs, Cont), Iport, Oport); -get_line({What,Cont0,Rs}, Iport, Oport) -> - io_requests(Rs, Iport, Oport), - receive - {Iport,{data,Cs}} -> - get_line(edlin:edit_line(Cs, Cont0), Iport, Oport); - {Iport,eof} -> - get_line(edlin:edit_line(eof, Cont0), Iport, Oport) - after - get_line_timeout(What) -> - get_line(edlin:edit_line([], Cont0), Iport, Oport) - end. - -get_line_timeout(blink) -> 1000; -get_line_timeout(more_chars) -> infinity. - -% Let driver report window geometry, -% definitely outside of the common interface -get_tty_geometry(Iport) -> - case (catch port_control(Iport,?CTRL_OP_GET_WINSIZE,[])) of - List when length(List) =:= 8 -> - <<W:32/native,H:32/native>> = list_to_binary(List), - {W,H}; - _ -> - error - end. -get_unicode_state(Iport) -> - case (catch port_control(Iport,?CTRL_OP_GET_UNICODE_STATE,[])) of - [Int] when Int > 0 -> - true; - [Int] when Int =:= 0 -> - false; - _ -> - error - end. - -set_unicode_state(Iport, Bool) -> - Data = case Bool of - true -> [1]; - false -> [0] - end, - case (catch port_control(Iport,?CTRL_OP_SET_UNICODE_STATE,Data)) of - [Int] when Int > 0 -> - {unicode, utf8}; - [Int] when Int =:= 0 -> - {unicode, false}; - _ -> - error + [{put_chars, unicode,<<" c [nn] - connect to job\n">>}, + {put_chars, unicode,<<" i [nn] - interrupt job\n">>}, + {put_chars, unicode,<<" k [nn] - kill job\n">>}, + {put_chars, unicode,<<" j - list all jobs\n">>}, + {put_chars, unicode,<<" s [shell] - start local shell\n">>}, + {put_chars, unicode,<<" r [node [shell]] - start remote shell\n">>}] ++ + QuitReq ++ + [{put_chars, unicode,<<" ? | h - this message\n">>}]. + +group_opts(Node) -> + VersionString = erpc:call(Node, erlang, system_info, [otp_release]), + Version = list_to_integer(VersionString), + ExpandFun = + case Version > 25 of + true -> [{expand_fun,fun(B, Opts)-> erpc:call(Node,edlin_expand,expand,[B, Opts]) end}]; + false -> [{expand_fun,fun(B, _)-> erpc:call(Node,edlin_expand,expand,[B]) end}] + end, + group_opts() ++ ExpandFun. +group_opts() -> + [{expand_below, application:get_env(stdlib, shell_expand_location, below) =:= below}]. + +-spec io_request(request(), prim_tty:state()) -> {noreply, prim_tty:state()} | + {term(), reference(), prim_tty:state()}. +io_request({requests,Rs}, TTY) -> + {noreply, io_requests(Rs, TTY)}; +io_request(redraw_prompt, TTY) -> + write(prim_tty:handle_request(TTY, redraw_prompt)); +io_request({redraw_prompt, Pbs, Pbs2, LineState}, TTY) -> + write(prim_tty:handle_request(TTY, {redraw_prompt, Pbs, Pbs2, LineState})); +io_request(new_prompt, TTY) -> + write(prim_tty:handle_request(TTY, new_prompt)); +io_request(delete_after_cursor, TTY) -> + write(prim_tty:handle_request(TTY, delete_after_cursor)); +io_request(delete_line, TTY) -> + write(prim_tty:handle_request(TTY, delete_line)); +io_request({put_chars_keep_state, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {putc_keep_state, unicode:characters_to_binary(Chars)})); +io_request({put_chars, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {putc, unicode:characters_to_binary(Chars)})); +io_request({put_chars_sync, unicode, Chars, Reply}, TTY) -> + {Output, NewTTY} = prim_tty:handle_request(TTY, {putc, unicode:characters_to_binary(Chars)}), + {ok, MonitorRef} = prim_tty:write(NewTTY, Output, self()), + {Reply, MonitorRef, NewTTY}; +io_request({put_chars_sync, latin1, Chars, Reply}, TTY) -> + {Output, NewTTY} = prim_tty:handle_request(TTY, {putc_raw, Chars}), + {ok, MonitorRef} = prim_tty:write(NewTTY, Output, self()), + {Reply, MonitorRef, NewTTY}; +io_request({put_expand, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {expand_with_trim, unicode:characters_to_binary(Chars)})); +io_request({put_expand_no_trim, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {expand, unicode:characters_to_binary(Chars)})); +io_request({move_rel, N}, TTY) -> + write(prim_tty:handle_request(TTY, {move, N})); +io_request({move_line, R}, TTY) -> + write(prim_tty:handle_request(TTY, {move_line, R})); +io_request({move_combo, V1, R, V2}, TTY) -> + write(prim_tty:handle_request(TTY, {move_combo, V1, R, V2})); +io_request({insert_chars, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {insert, unicode:characters_to_binary(Chars)})); +io_request({delete_chars, N}, TTY) -> + write(prim_tty:handle_request(TTY, {delete, N})); +io_request(clear, TTY) -> + write(prim_tty:handle_request(TTY, clear)); +io_request(beep, TTY) -> + write(prim_tty:handle_request(TTY, beep)). + +write({Output, TTY}) -> + ok = prim_tty:write(TTY, Output), + {noreply, TTY}. + +io_requests([{insert_chars, unicode, C1},{insert_chars, unicode, C2}|Rs], TTY) -> + io_requests([{insert_chars, unicode, [C1,C2]}|Rs], TTY); +io_requests([{put_chars, unicode, C1},{put_chars, unicode, C2}|Rs], TTY) -> + io_requests([{put_chars, unicode, [C1,C2]}|Rs], TTY); +io_requests([{move_rel, N}, {move_line, R}, {move_rel, M}|Rs], TTY) -> + io_requests([{move_combo, N, R, M}|Rs], TTY); +io_requests([{move_rel, N}, {move_line, R}|Rs], TTY) -> + io_requests([{move_combo, N, R, 0}|Rs], TTY); +io_requests([{move_line, R}, {move_rel, M}|Rs], TTY) -> + io_requests([{move_combo, 0, R, M}|Rs], TTY); +io_requests([R|Rs], TTY) -> + {noreply, NewTTY} = io_request(R, TTY), + io_requests(Rs, NewTTY); +io_requests([], TTY) -> + TTY. + +open_editor(TTY, Buffer) -> + DefaultEditor = + case os:type() of + {win32, _} -> "notepad"; + {unix, _} -> "nano" + end, + Editor = os:getenv("VISUAL", os:getenv("EDITOR", DefaultEditor)), + TmpFile = string:chomp(mktemp()) ++ ".erl", + _ = file:write_file(TmpFile, unicode:characters_to_binary(Buffer, unicode)), + case filelib:is_file(TmpFile) of + true -> + ok = prim_tty:disable_reader(TTY), + try + EditorPort = + case os:type() of + {win32, _} -> + [Cmd | Args] = string:split(Editor," ", all), + open_port({spawn_executable, os:find_executable(Cmd)}, + [{args,Args ++ [TmpFile]}, nouse_stdio]); + {unix, _ } -> + open_port({spawn, Editor ++ " " ++ TmpFile}, [nouse_stdio]) + end, + {EditorPort, TmpFile} + catch error:enoent -> + ok = prim_tty:enable_reader(TTY), + io:format(standard_error, "Could not find EDITOR '~ts'.~n", [Editor]), + false + end; + false -> + io:format(standard_error, + "Could not find create temp file '~ts'.~n", + [TmpFile]), + false end. -%% io_request(Request, InPort, OutPort) -%% io_requests(Requests, InPort, OutPort) -%% Note: InPort is unused. -io_request({requests,Rs}, Iport, Oport) -> - io_requests(Rs, Iport, Oport); -io_request(Request, _Iport, Oport) -> - case io_command(Request) of - {Data, Reply} -> - true = port_command(Oport, Data), - Reply; - unhandled -> - ok +mktemp() -> + case os:type() of + {win32, _} -> + os:cmd("powershell \"write-host (& New-TemporaryFile | Select-Object -ExpandProperty FullName)\""); + {unix,_} -> + os:cmd("mktemp") end. -io_requests([R|Rs], Iport, Oport) -> - io_request(R, Iport, Oport), - io_requests(Rs, Iport, Oport); -io_requests([], _Iport, _Oport) -> - ok. - -put_int16(N, Tail) -> - [(N bsr 8)band 255,N band 255|Tail]. - -%% When a put_chars_sync command is used, user_drv guarantees that -%% the bytes have been put in the buffer of the port before an acknowledgement -%% is sent back to the process sending the request. This command was added in -%% OTP 18 to make sure that data sent from io:format is actually printed -%% to the console before the vm stops when calling erlang:halt(integer()). --dialyzer({no_improper_lists, io_command/1}). -io_command({put_chars_sync, unicode,Cs,Reply}) -> - {[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)], Reply}; -io_command({put_chars, unicode,Cs}) -> - {[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)], ok}; -io_command({move_rel,N}) -> - {[?OP_MOVE|put_int16(N, [])], ok}; -io_command({insert_chars,unicode,Cs}) -> - {[?OP_INSC|unicode:characters_to_binary(Cs,utf8)], ok}; -io_command({delete_chars,N}) -> - {[?OP_DELC|put_int16(N, [])], ok}; -io_command(beep) -> - {[?OP_BEEP], ok}; -io_command(_) -> - unhandled. +handle_req(next, TTYState, {false, IOQ} = IOQueue) -> + case queue:out(IOQ) of + {empty, _} -> + {TTYState, IOQueue}; + {{value, {Origin, Req}}, ExecQ} -> + case io_request(Req, TTYState) of + {noreply, NewTTYState} -> + handle_req(next, NewTTYState, {false, ExecQ}); + {Reply, MonitorRef, NewTTYState} -> + {NewTTYState, {{Origin, MonitorRef, Reply}, ExecQ}} + end + end; +handle_req(Msg, TTYState, {false, IOQ} = IOQueue) -> + empty = queue:peek(IOQ), + {Origin, Req} = Msg, + case io_request(Req, TTYState) of + {noreply, NewTTYState} -> + {NewTTYState, IOQueue}; + {Reply, MonitorRef, NewTTYState} -> + {NewTTYState, {{Origin, MonitorRef, Reply}, IOQ}} + end; +handle_req(Msg,TTYState,{Resp, IOQ}) -> + %% All requests are queued when we have outstanding sync put_chars + {TTYState, {Resp, queue:in(Msg,IOQ)}}. %% gr_new() %% gr_get_num(Group, Index) @@ -611,100 +910,71 @@ io_command(_) -> %% gr_add_cur(Group, Pid, Shell) %% gr_set_cur(Group, Index) %% gr_cur_pid(Group) +%% gr_cur_index(Group) %% gr_del_pid(Group, Pid) %% Manage the group list. The group structure has the form: %% {NextIndex,CurrIndex,CurrPid,GroupList} %% %% where each element in the group list is: %% {Index,GroupPid,Shell} - +-record(group, { index, pid, shell }). +-record(gr, { next = 0, current = 0, pid = none, groups = []}). gr_new() -> - {0,0,none,[]}. - -gr_get_num({_Next,_CurI,_CurP,Gs}, I) -> - gr_get_num1(Gs, I). - -gr_get_num1([{I,_Pid,{}}|_Gs], I) -> - undefined; -gr_get_num1([{I,Pid,_S}|_Gs], I) -> - {pid,Pid}; -gr_get_num1([_G|Gs], I) -> - gr_get_num1(Gs, I); -gr_get_num1([], _I) -> - undefined. - -gr_get_info({_Next,_CurI,_CurP,Gs}, Pid) -> - gr_get_info1(Gs, Pid). - -gr_get_info1([{I,Pid,S}|_Gs], Pid) -> - {I,S}; -gr_get_info1([_G|Gs], I) -> - gr_get_info1(Gs, I); -gr_get_info1([], _I) -> - undefined. - -gr_add_cur({Next,_CurI,_CurP,Gs}, Pid, Shell) -> - {Next+1,Next,Pid,append(Gs, [{Next,Pid,Shell}])}. - -gr_set_cur({Next,_CurI,_CurP,Gs}, I) -> - case gr_get_num1(Gs, I) of - {pid,Pid} -> {ok,{Next,I,Pid,Gs}}; + #gr{}. +gr_new_group(I, P, S) -> + #group{ index = I, pid = P, shell = S }. + +gr_get_num(#gr{ groups = Gs }, I) -> + case lists:keyfind(I, #group.index, Gs) of + false -> undefined; + #group{ shell = {} } -> + undefined; + #group{ pid = Pid } -> + {pid, Pid} + end. + +gr_get_info(#gr{ groups = Gs }, Pid) -> + case lists:keyfind(Pid, #group.pid, Gs) of + false -> undefined; + #group{ index = I, shell = S } -> + {I, S} + end. + +gr_add_cur(#gr{ next = Next, groups = Gs}, Pid, Shell) -> + put(current_group, Pid), + #gr{ next = Next + 1, current = Next, pid = Pid, + groups = Gs ++ [gr_new_group(Next, Pid, Shell)] + }. + +gr_set_cur(Gr, I) -> + case gr_get_num(Gr, I) of + {pid,Pid} -> + put(current_group, Pid), + {ok, Gr#gr{ current = I, pid = Pid }}; undefined -> undefined end. -gr_set_num({Next,CurI,CurP,Gs}, I, Pid, Shell) -> - {Next,CurI,CurP,gr_set_num1(Gs, I, Pid, Shell)}. - -gr_set_num1([{I,_Pid,_Shell}|Gs], I, NewPid, NewShell) -> - [{I,NewPid,NewShell}|Gs]; -gr_set_num1([{I,Pid,Shell}|Gs], NewI, NewPid, NewShell) when NewI > I -> - [{I,Pid,Shell}|gr_set_num1(Gs, NewI, NewPid, NewShell)]; -gr_set_num1(Gs, NewI, NewPid, NewShell) -> - [{NewI,NewPid,NewShell}|Gs]. - -gr_del_pid({Next,CurI,CurP,Gs}, Pid) -> - {Next,CurI,CurP,gr_del_pid1(Gs, Pid)}. - -gr_del_pid1([{_I,Pid,_S}|Gs], Pid) -> - Gs; -gr_del_pid1([G|Gs], Pid) -> - [G|gr_del_pid1(Gs, Pid)]; -gr_del_pid1([], _Pid) -> - []. - -gr_cur_pid({_Next,_CurI,CurP,_Gs}) -> - CurP. - -gr_list({_Next,CurI,_CurP,Gs}) -> - gr_list(Gs, CurI, []). - -gr_list([{_I,_Pid,{}}|Gs], Cur, Jobs) -> - gr_list(Gs, Cur, Jobs); -gr_list([{Cur,_Pid,Shell}|Gs], Cur, Jobs) -> - gr_list(Gs, Cur, [{put_chars, unicode,flatten(io_lib:format("~4w* ~w\n", [Cur,Shell]))}|Jobs]); -gr_list([{I,_Pid,Shell}|Gs], Cur, Jobs) -> - gr_list(Gs, Cur, [{put_chars, unicode,flatten(io_lib:format("~4w ~w\n", [I,Shell]))}|Jobs]); -gr_list([], _Cur, Jobs) -> - lists:reverse(Jobs). - -append([H|T], X) -> - [H|append(T, X)]; -append([], X) -> - X. - -member(X, [X|_Rest]) -> true; -member(X, [_H|Rest]) -> - member(X, Rest); -member(_X, []) -> false. - -flatten(List) -> - flatten(List, [], []). - -flatten([H|T], Cont, Tail) when is_list(H) -> - flatten(H, [T|Cont], Tail); -flatten([H|T], Cont, Tail) -> - [H|flatten(T, Cont, Tail)]; -flatten([], [H|Cont], Tail) -> - flatten(H, Cont, Tail); -flatten([], [], Tail) -> - Tail. +gr_set_num(Gr = #gr{ groups = Groups }, I, Pid, Shell) -> + NewGroups = lists:keystore(I, #group.index, Groups, gr_new_group(I,Pid,Shell)), + Gr#gr{ groups = NewGroups }. + + +gr_del_pid(Gr = #gr{ groups = Groups }, Pid) -> + Gr#gr{ groups = lists:keydelete(Pid, #group.pid, Groups) }. + + +gr_cur_pid(#gr{ pid = Pid }) -> + Pid. +gr_cur_index(#gr{ current = Index }) -> + Index. + +gr_list(#gr{ current = Current, groups = Groups}) -> + lists:flatmap( + fun(#group{ shell = {} }) -> + []; + (#group{ index = I, shell = S }) -> + Marker = ["*" || Current =:= I], + [{put_chars, unicode, + unicode:characters_to_binary( + io_lib:format("~4w~.1ts ~w\n", [I,Marker,S]))}] + end, Groups). |