diff --git a/erts/emulator/nifs/common/prim_tty_nif.c b/erts/emulator/nifs/common/prim_tty_nif.c index 1eee3dbccfc..acd50261c3e 100644 --- a/erts/emulator/nifs/common/prim_tty_nif.c +++ b/erts/emulator/nifs/common/prim_tty_nif.c @@ -102,9 +102,6 @@ typedef struct { ErlNifPid self; ErlNifPid reader; int tty; /* if the tty is initialized */ -#ifndef __WIN32__ - int signal[2]; /* Pipe used for signal (winch + cont) notifications */ -#endif #ifdef HAVE_TERMCAP struct termios tty_smode; struct termios tty_rmode; @@ -142,14 +139,12 @@ static ERL_NIF_TERM tty_tgetnum_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM static ERL_NIF_TERM tty_tgetflag_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM tty_tgetstr_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM tty_tgoto_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM tty_read_signal_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ErlNifFunc nif_funcs[] = { {"isatty", 1, isatty_nif}, {"tty_create", 0, tty_create_nif}, {"tty_init", 3, tty_init_nif}, {"tty_set", 1, tty_set_nif}, - {"tty_read_signal", 2, tty_read_signal_nif}, {"setlocale", 1, setlocale_nif}, {"tty_select", 3, tty_select_nif}, {"tty_window_size", 1, tty_window_size_nif}, @@ -1015,60 +1010,6 @@ static ERL_NIF_TERM tty_window_size_nif(ErlNifEnv* env, int argc, const ERL_NIF_ )); } -#ifndef __WIN32__ - -static int tty_signal_fd = -1; - -static RETSIGTYPE tty_cont(int sig) -{ - if (tty_signal_fd != 1) { - while (write(tty_signal_fd, "c", 1) < 0 && errno == EINTR) { }; - } -} - - -static RETSIGTYPE tty_winch(int sig) -{ - if (tty_signal_fd != 1) { - while (write(tty_signal_fd, "w", 1) < 0 && errno == EINTR) { }; - } -} - -#endif - -static ERL_NIF_TERM tty_read_signal_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - TTYResource *tty; - char buff[1]; - ssize_t ret; - ERL_NIF_TERM res; - if (!enif_get_resource(env, argv[0], tty_rt, (void **)&tty)) - return enif_make_badarg(env); -#ifndef __WIN32__ - do { - ret = read(tty->signal[0], buff, 1); - } while (ret < 0 && errno == EAGAIN); - - if (ret < 0) { - return make_errno_error(env, "read"); - } else if (ret == 0) { - return make_error(env, enif_make_atom(env,"empty")); - } - - enif_select(env, tty->signal[0], ERL_NIF_SELECT_READ, tty, NULL, argv[1]); - - if (buff[0] == 'w') { - res = enif_make_atom(env, "winch"); - } else if (buff[0] == 'c') { - res = enif_make_atom(env, "cont"); - } else { - res = enif_make_string_len(env, buff, 1, ERL_NIF_LATIN1); - } - return enif_make_tuple2(env, atom_ok, res); -#else - return make_enotsup(env); -#endif -} - static ERL_NIF_TERM tty_select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { TTYResource *tty; #ifndef __WIN32__ @@ -1080,16 +1021,6 @@ static ERL_NIF_TERM tty_select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_make_badarg(env); #ifndef __WIN32__ - if (pipe(tty->signal) == -1) { - return make_errno_error(env, "pipe"); - } - SET_NONBLOCKING(tty->signal[0]); - enif_select(env, tty->signal[0], ERL_NIF_SELECT_READ, tty, NULL, argv[1]); - tty_signal_fd = tty->signal[1]; - - sys_signal(SIGCONT, tty_cont); - sys_signal(SIGWINCH, tty_winch); - using_oldshell = 0; enif_select(env, tty->ifd, ERL_NIF_SELECT_READ, tty, NULL, argv[2]); @@ -1128,12 +1059,6 @@ static void tty_monitor_down(ErlNifEnv* caller_env, void* obj, ErlNifPid* pid, E #endif if (enif_compare_pids(pid, &tty->reader) == 0) { enif_select(caller_env, tty->ifd, ERL_NIF_SELECT_STOP, tty, NULL, atom_undefined); -#ifndef __WIN32__ - enif_select(caller_env, tty->signal[0], ERL_NIF_SELECT_STOP, tty, NULL, atom_undefined); - close(tty->signal[1]); - sys_signal(SIGCONT, SIG_DFL); - sys_signal(SIGWINCH, SIG_DFL); -#endif } } diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 62218a8c4aa..fc317a77e05 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -146,6 +146,7 @@ MODULES = \ user_drv \ user_sup \ prim_tty \ + prim_tty_sighandler \ raw_file_io \ raw_file_io_compressed \ raw_file_io_inflate \ diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 897e9aa70a6..03cb36e8f32 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -89,6 +89,7 @@ user_drv, user_sup, prim_tty, + prim_tty_sighandler, disk_log, disk_log_1, disk_log_server, diff --git a/lib/kernel/src/prim_tty.erl b/lib/kernel/src/prim_tty.erl index 4c08fe9f4c3..4abccf76732 100644 --- a/lib/kernel/src/prim_tty.erl +++ b/lib/kernel/src/prim_tty.erl @@ -115,9 +115,9 @@ tty_select/3, tty_window_size/1, tty_encoding/1, write_nif/2, read_nif/2, isprint/1, wcwidth/1, wcswidth/1, sizeof_wchar/0, tgetent_nif/1, tgetnum_nif/1, tgetflag_nif/1, tgetstr_nif/1, - tgoto_nif/1, tgoto_nif/2, tgoto_nif/3, tty_read_signal/2]). + tgoto_nif/1, tgoto_nif/2, tgoto_nif/3]). --export([reader_loop/6, writer_loop/2]). +-export([reader_loop/5, writer_loop/2]). %% Exported in order to remove "unused function" warning -export([sizeof_wchar/0, wcswidth/1, tgoto/1, tgoto/2, tgoto/3]). @@ -320,6 +320,27 @@ init_term(State = #state{ tty = TTY, options = Options }) -> WriterState end, + %% `prim_tty' has signal handlers for SIGCONT and SIGWINCH. + %% + %% Historically, these signals were caught by `prim_tty_nif.c' and + %% forwarded to this process. + %% + %% After SIGCONT and SIGWINCH support was added, this module uses a + %% gen_event handler in `prim_tty_sighandler'. + _ = gen_event:delete_handler( + erl_signal_server, prim_tty_sighandler, + undefined), + case ReaderState#state.reader of + {_ReaderPid, ReaderRef} -> + ok = gen_event:add_handler( + erl_signal_server, prim_tty_sighandler, + #{parent => self(), reader => ReaderRef}), + ok = os:set_signal(sigcont, handle), + ok = os:set_signal(sigwinch, handle); + undefined -> + ok + end, + update_geometry(ReaderState). -spec reinit(state(), options()) -> state(). @@ -497,34 +518,29 @@ call(Pid, Msg) -> reader([TTY, Encoding, Parent]) -> register(user_drv_reader, self()), ReaderRef = make_ref(), - SignalRef = make_ref(), - ok = tty_select(TTY, SignalRef, ReaderRef), + ok = tty_select(TTY, undefined, ReaderRef), proc_lib:init_ack({ok, {self(), ReaderRef}}), FromEnc = case tty_encoding(TTY) of utf8 -> Encoding; Else -> Else end, - reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, <<>>). + reader_loop(TTY, Parent, ReaderRef, FromEnc, <<>>). -reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc) -> +reader_loop(TTY, Parent, ReaderRef, FromEnc, Acc) -> receive {DisableAlias, disable} -> DisableAlias ! {DisableAlias, ok}, receive {EnableAlias, enable} -> EnableAlias ! {EnableAlias, ok}, - ?MODULE:reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc) + ?MODULE:reader_loop(TTY, Parent, ReaderRef, FromEnc, Acc) end; - {select, TTY, SignalRef, ready_input} -> - {ok, Signal} = tty_read_signal(TTY, SignalRef), - Parent ! {ReaderRef,{signal,Signal}}, - ?MODULE:reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc); {set_unicode_state, _} when FromEnc =:= {utf16, little} -> - ?MODULE:reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc); + ?MODULE:reader_loop(TTY, Parent, ReaderRef, FromEnc, Acc); {set_unicode_state, Bool} -> NewFromEnc = if Bool -> utf8; not Bool -> latin1 end, - ?MODULE:reader_loop(TTY, Parent, SignalRef, ReaderRef, NewFromEnc, Acc); + ?MODULE:reader_loop(TTY, Parent, ReaderRef, NewFromEnc, Acc); {_Alias, stop} -> ok; {select, TTY, ReaderRef, ready_input} -> @@ -538,10 +554,10 @@ reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc) -> %% Windows when we change from "noshell" to "newshell". %% When it happens we need to re-read the tty_encoding as %% it has changed. - reader_loop(TTY, Parent, SignalRef, ReaderRef, tty_encoding(TTY), Acc); + reader_loop(TTY, Parent, ReaderRef, tty_encoding(TTY), Acc); {ok, <<>>} -> %% EAGAIN or EINTR - ?MODULE:reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc); + ?MODULE:reader_loop(TTY, Parent, ReaderRef, FromEnc, Acc); {ok, UtfXBytes} -> %% read_nif may have blocked for a long time, so we check if @@ -570,7 +586,7 @@ reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc) -> {B, <<>>, UpdatedFromEnc} end, Parent ! {ReaderRef, {data, Bytes}}, - ?MODULE:reader_loop(TTY, Parent, SignalRef, ReaderRef, NewFromEnc, NewAcc) + ?MODULE:reader_loop(TTY, Parent, ReaderRef, NewFromEnc, NewAcc) end end. @@ -1403,7 +1419,7 @@ tty_set(_TTY) -> erlang:nif_error(undef). setlocale(_TTY) -> erlang:nif_error(undef). -tty_select(_TTY, _SignalRef, _ReadRef) -> +tty_select(_TTY, undefined, _ReadRef) -> erlang:nif_error(undef). tty_encoding(_TTY) -> erlang:nif_error(undef). @@ -1454,6 +1470,3 @@ tgoto_nif(_Ent, _Arg) -> erlang:nif_error(undef). tgoto_nif(_Ent, _Arg1, _Arg2) -> erlang:nif_error(undef). -tty_read_signal(_TTY, _Ref) -> - erlang:nif_error(undef). - diff --git a/lib/kernel/src/prim_tty_sighandler.erl b/lib/kernel/src/prim_tty_sighandler.erl new file mode 100644 index 00000000000..0d313f409c8 --- /dev/null +++ b/lib/kernel/src/prim_tty_sighandler.erl @@ -0,0 +1,45 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2024. 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(prim_tty_sighandler). +-moduledoc false. + +-behaviour(gen_event). + +-export([init/1, handle_event/2, handle_call/2, code_change/3]). + +init(#{parent := _, reader := _} = State) -> + {ok, State}. + +handle_event(Signal, #{parent := Parent, reader := ReaderRef} = State) + when Signal =:= sigcont orelse Signal =:= sigwinch -> + ShortSignal = case Signal of + sigcont -> cont; + sigwinch -> winch + end, + Parent ! {ReaderRef, {signal, ShortSignal}}, + {ok, State}; +handle_event(_Signal, State) -> + %% Other signals are ignored by `prim_tty'. + {ok, State}. + +handle_call(_Request, State) -> + {ok, ok, State}. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. diff --git a/lib/kernel/test/tty.cover b/lib/kernel/test/tty.cover index cf4d26ea8e1..8190ba41ffa 100644 --- a/lib/kernel/test/tty.cover +++ b/lib/kernel/test/tty.cover @@ -1,3 +1,3 @@ %% -*- erlang -*- -{incl_mods,[prim_tty, user_drv, group, shell, edlin, edlin_expand, io_lib]}. +{incl_mods,[prim_tty, prim_tty_sighandler, user_drv, group, shell, edlin, edlin_expand, io_lib]}.