From e8ad79c54bb2b12f18be183d032ad5f803d03fe9 Mon Sep 17 00:00:00 2001 From: frazze-jobb Date: Sat, 28 Oct 2023 15:11:57 +0200 Subject: [PATCH] ssh: support dumb ssh client terminals --- lib/kernel/src/group.erl | 55 +++++++++++++++++++++++++--------------- lib/ssh/src/ssh_cli.erl | 47 +++++++++++++++++++++++----------- lib/stdlib/src/edlin.erl | 2 +- 3 files changed, 68 insertions(+), 36 deletions(-) diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index bfb6e51e1c0b..2905b89e2e4f 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -49,7 +49,10 @@ server(Ancestors, Drv, Shell, Options) -> put(user_drv, Drv), ExpandFun = normalize_expand_fun(Options, fun edlin_expand:expand/2), put(expand_fun, ExpandFun), - put(echo, proplists:get_value(echo, Options, true)), + Echo = proplists:get_value(echo, Options, true), + put(echo, Echo), + Dumb = proplists:get_value(dumb, Options, false), + put(dumb, Dumb), put(expand_below, proplists:get_value(expand_below, Options, true)), server_loop(Drv, start_shell(Shell), []). @@ -490,7 +493,7 @@ get_chars_line(Prompt, M, F, Xa, Drv, Shell, Buf, Encoding) -> get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf, start, [], Encoding). get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf0, State, LineCont0, Encoding) -> - Result = case get(echo) of + Result = case not(get(dumb)) andalso get(echo) of true -> get_line(Buf0, Pbs, LineCont0, Drv, Shell, Encoding); false -> @@ -512,7 +515,7 @@ get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf0, State, LineCont0, Encoding) -> get_chars_apply(Pbs, M, F, Xa, Drv, Shell, Buf, State0, LineCont, Encoding) -> %% multi line support means that we should not keep the state %% but we need to keep it for oldshell mode - {State, Line} = case get(echo) of + {State, Line} = case not(get(dumb)) andalso get(echo) of true -> {start, edlin:current_line(LineCont)}; false -> {State0, LineCont} end, @@ -820,7 +823,11 @@ get_line_echo_off(Chars, Pbs, Drv, Shell) -> send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]), get_line_echo_off1(edit_line(Chars,[]), Drv, Shell). -get_line_echo_off1({Chars,[]}, Drv, Shell) -> +get_line_echo_off1({Chars,[],Rs}, Drv, Shell) -> + case get(echo) of + true -> send_drv_reqs(Drv, Rs); + false -> skip + end, receive {Drv,{data,Cs}} -> get_line_echo_off1(edit_line(cast(Cs, list), Chars), Drv, Shell); @@ -842,7 +849,11 @@ get_line_echo_off1({Chars,[]}, Drv, Shell) -> end; get_line_echo_off1(eof, _Drv, _Shell) -> {done,eof,eof}; -get_line_echo_off1({Chars,Rest}, _Drv, _Shell) -> +get_line_echo_off1({Chars,Rest,Rs}, Drv, _Shell) -> + case get(echo) of + true -> send_drv_reqs(Drv, Rs); + false -> skip + end, {done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}. get_chars_echo_off(Pbs, Drv, Shell) -> @@ -879,22 +890,26 @@ get_chars_echo_off1(Drv, Shell) -> %% - ^d in posix/icanon mode: eof, delete-forward in edlin %% - ^r in posix/icanon mode: reprint (silly in echo-off mode :-)) %% - ^w in posix/icanon mode: word-erase (produces a beep in edlin) -edit_line(eof, []) -> +edit_line(Input, State) -> + edit_line(Input, State, []). +edit_line(eof, [], _) -> eof; -edit_line(eof, Chars) -> - {Chars,eof}; -edit_line([],Chars) -> - {Chars,[]}; -edit_line([$\r,$\n|Cs],Chars) -> - {[$\n | Chars], remainder_after_nl(Cs)}; -edit_line([NL|Cs],Chars) when NL =:= $\r; NL =:= $\n -> - {[$\n | Chars], remainder_after_nl(Cs)}; -edit_line([Erase|Cs],[]) when Erase =:= $\177; Erase =:= $\^H -> - edit_line(Cs,[]); -edit_line([Erase|Cs],[_|Chars]) when Erase =:= $\177; Erase =:= $\^H -> - edit_line(Cs,Chars); -edit_line([Char|Cs],Chars) -> - edit_line(Cs,[Char|Chars]). +edit_line(eof, Chars, Rs) -> + {Chars,eof, lists:reverse(Rs)}; +edit_line([],Chars, Rs) -> + {Chars,[],lists:reverse(Rs)}; +edit_line([$\r,$\n|Cs],Chars, Rs) -> + {[$\n | Chars], remainder_after_nl(Cs), lists:reverse([{insert_chars, unicode, "\n"}|Rs])}; +edit_line([NL|Cs],Chars, Rs) when NL =:= $\r; NL =:= $\n -> + {[$\n | Chars], remainder_after_nl(Cs), lists:reverse([{insert_chars, unicode, "\n"}|Rs])}; +edit_line([Erase|Cs],[], Rs) when Erase =:= $\177; Erase =:= $\^H -> + edit_line(Cs,[], Rs); +edit_line([Erase|Cs],[_|Chars], Rs) when Erase =:= $\177; Erase =:= $\^H -> + edit_line(Cs,Chars, [{delete_chars, -1}|Rs]); +edit_line([CtrlChar|Cs],Chars, Rs) when CtrlChar =< 32 -> + edit_line(Cs,Chars,Rs); +edit_line([Char|Cs],Chars, Rs) -> + edit_line(Cs,[Char|Chars], [{insert_chars, unicode, [Char]}|Rs]). remainder_after_nl("") -> done; remainder_after_nl(Cs) -> Cs. diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 9f6d3be21d91..2677670de95a 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -79,7 +79,9 @@ handle_ssh_msg({ssh_cm, _ConnectionHandler, #state{group = Group} = State0) -> {Enc, State} = guess_encoding(Data, State0), List = unicode:characters_to_list(Data, Enc), - to_group(List, Group), + Pty = State#state.pty, + Dumb = Pty#ssh_pty.term =:= "dumb", + to_group(List, Group, Dumb), {ok, State}; handle_ssh_msg({ssh_cm, ConnectionHandler, @@ -393,21 +395,28 @@ out_enc(#state{encoding = PeerEnc, %%-------------------------------------------------------------------- -to_group([], _Group) -> +to_group([], _Group, _Dumb) -> ok; -to_group([$\^C | Tail], Group) -> +to_group([$\^C | Tail], Group, Dumb) -> exit(Group, interrupt), - to_group(Tail, Group); -to_group(Data, Group) -> + to_group(Tail, Group, Dumb); +to_group(Data, Group, Dumb) -> Func = fun(C) -> C /= $\^C end, Tail = case lists:splitwith(Func, Data) of {[], Right} -> Right; {Left, Right} -> - Group ! {self(), {data, Left}}, + %% Filter out escape sequences, only support Ctrl sequences + Left1 = if Dumb -> replace_escapes(Left); true -> Left end, + Group ! {self(), {data, Left1}}, Right end, - to_group(Tail, Group). + to_group(Tail, Group, Dumb). +replace_escapes(Data) -> + lists:flatten([ if C =:= 27 -> + [$^,C+64]; + true -> C + end || C <- Data]). %%-------------------------------------------------------------------- %%% io_request, handle io requests from the user process, @@ -509,10 +518,10 @@ get_tty_command(left, N, _TerminalType) -> -define(TABWIDTH, 8). %% convert input characters to buffer and to writeout -%% Note that the buf is reversed but the buftail is not +%% Note that Bef is reversed but Aft is not %% (this is handy; the head is always next to the cursor) conv_buf([], {LB, {Bef, Aft}, LA, Col}, AccWrite, _Tty) -> - {{LB, {Bef, Aft}, LA}, lists:reverse(AccWrite), Col}; + {{LB, {Bef, Aft}, LA, Col}, lists:reverse(AccWrite)}; conv_buf([13, 10 | Rest], {LB, {Bef, Aft}, LA, Col}, AccWrite, Tty = #ssh_pty{width = W}) -> conv_buf(Rest, {[lists:reverse(Bef)|LB], {[], tl2(Aft)}, LA, Col+(W-(Col rem W))}, [10, 13 | AccWrite], Tty); conv_buf([13 | Rest], {LB, {Bef, Aft}, LA, Col}, AccWrite, Tty = #ssh_pty{width = W}) -> @@ -531,20 +540,24 @@ conv_buf([C | Rest], {LB, {Bef, Aft}, LA, Col}, AccWrite, Tty) -> %%% put characters before the prompt put_chars(Chars, Buf, Tty) -> case Buf of - {[],{[],[]},[],_} -> {_, WriteBuf, _} = conv_buf(Chars, Buf, [], Tty), + {[],{[],[]},[],_} -> {_, WriteBuf} = conv_buf(Chars, Buf, [], Tty), {WriteBuf, Buf}; - _ -> + _ when Tty#ssh_pty.term =/= "dumb" -> {Delete, DeletedState} = io_request(delete_line, Buf, Tty, []), - {_, PutBuffer, _} = conv_buf(Chars, DeletedState, [], Tty), + {_, PutBuffer} = conv_buf(Chars, DeletedState, [], Tty), {Redraw, _} = io_request(redraw_prompt_pre_deleted, Buf, Tty, []), - {[Delete, PutBuffer, Redraw], Buf} + {[Delete, PutBuffer, Redraw], Buf}; + _ -> %% When we have a dumb terminal, we don't support redrawing the prompt + %% Instead just put the characters on the screen + {NewBuf, WriteBuf} = conv_buf(Chars, Buf, [], Tty), + {WriteBuf, NewBuf} end. %%% insert character at current position insert_chars([], Buf, _Tty) -> {[], Buf}; insert_chars(Chars, {_LB,{_Bef, Aft},LA, _Col}=Buf, Tty) -> - {{NewLB, {NewBef, _NewAft}, _NewLA}, WriteBuf, NewCol} = conv_buf(Chars, Buf, [], Tty), + {{NewLB, {NewBef, _NewAft}, _NewLA, NewCol}, WriteBuf} = conv_buf(Chars, Buf, [], Tty), M = move_cursor(special_at_width(NewCol+length(Aft), Tty), NewCol, Tty), {[WriteBuf, Aft | M], {NewLB,{NewBef, Aft},LA, NewCol}}. @@ -722,8 +735,12 @@ start_shell(ConnectionHandler, State) -> {_,_,_} = Shell -> Shell end, + Dumb = case State#state.pty of + #ssh_pty{term = "dumb"} -> true; + _ -> false + end, State#state{group = group:start(self(), ShellSpawner, - [{expand_below, false}, + [{dumb, Dumb},{expand_below, false}, {echo, get_echo(State#state.pty)}]), buf = empty_buf()}. diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 431a3dc0ba06..a69924e127e2 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -74,7 +74,7 @@ start(Pbs) -> %% Only two modes used: 'none' and 'search'. Other modes can be %% handled inline through specific character handling. -start(Pbs, {_,{_,_},[]}=Cont) -> +start(Pbs, {_,{_,[]},[]}=Cont) -> %% Skip redraw if the cursor is at the end. {more_chars,{line,Pbs,Cont,{normal,none}},[{insert_chars,unicode,multi_line_prompt(Pbs)}]};