kernel,ssh: Add synchronous user_drv protocol

Added a put_chars_sync to the protocol that can be used to
talk to user_drv and made group use it. This is needed in order
to guarantee that bytes has been pushed to the tty port when
doing something like this:

io:format("halting\n"),erlang:halt(0).

Before this change the halting message could be lost in the message
queue of the user_drv process, this is no longer possible.

This commit also fixes ssh_cli as that plugs itself in as a user_drv
process.

OTP-12240

1 files changed, 92 insertions, 44 deletions

diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl
index a91c23539d..79f80f6604 100644
--- a/lib/kernel/src/user_drv.erl
+++ b/lib/kernel/src/user_drv.erl
@@ -29,6 +29,7 @@
 -define(OP_INSC,2).
 -define(OP_DELC,3).
 -define(OP_BEEP,4).
+-define(OP_PUTC_SYNC,5).
 % Control op
 -define(CTRL_OP_GET_WINSIZE,100).
 -define(CTRL_OP_GET_UNICODE_STATE,101).
@@ -133,7 +134,7 @@ server1(Iport, Oport, Shell) ->
 				      [erlang:system_info(system_version)]))},
 	       Iport, Oport),
     %% Enter the server loop.
-    server_loop(Iport, Oport, Curr, User, Gr).
+    server_loop(Iport, Oport, Curr, User, Gr, queue:new()).
 
 rem_sh_opts(Node) ->
     [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}].
@@ -158,42 +159,46 @@ start_user() ->
 	    User
     end.
    
-server_loop(Iport, Oport, User, Gr) ->
+server_loop(Iport, Oport, User, Gr, IOQueue) ->
     Curr = gr_cur_pid(Gr),
     put(current_group, Curr),
-    server_loop(Iport, Oport, Curr, User, Gr).
+    server_loop(Iport, Oport, Curr, User, Gr, IOQueue).
 
-server_loop(Iport, Oport, Curr, User, Gr) ->
+server_loop(Iport, Oport, Curr, User, Gr, 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);
+	    port_bytes(Unicode, Iport, Oport, Curr, User, Gr, IOQueue);
 	{Iport,eof} ->
 	    Curr ! {self(),eof},
-	    server_loop(Iport, Oport, Curr, User, Gr);
-	{User,Req} ->	% never block from user!
-	    io_request(Req, Iport, Oport),
-	    server_loop(Iport, Oport, Curr, User, Gr);
-	{Curr,tty_geometry} ->
-	    Curr ! {self(),tty_geometry,get_tty_geometry(Iport)},
-	    server_loop(Iport, Oport, Curr, User, Gr);
-	{Curr,get_unicode_state} ->
-	    Curr ! {self(),get_unicode_state,get_unicode_state(Iport)},
-	    server_loop(Iport, Oport, Curr, User, Gr);
-	{Curr,set_unicode_state, Bool} ->
-	    Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)},
-	    server_loop(Iport, Oport, Curr, User, Gr);
-	{Curr,Req} ->
-	    io_request(Req, Iport, Oport),
-	    server_loop(Iport, Oport, Curr, User, Gr);
+	    server_loop(Iport, Oport, Curr, User, Gr, IOQueue);
+        {User,Req} when element(1,Req) == tty_geometry;
+                        element(1,Req) == get_unicode_state;
+                        element(1,Req) == set_unicode_state ->
+            %% We ignore these requests from User, could be a bug?
+            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
+            {{value,{Origin,Reply}},ReplyQ} = queue:out(IOQueue),
+            Origin ! {reply,Reply},
+            NewQ = handle_req(next, Iport, Oport, ReplyQ),
+            server_loop(Iport, Oport, Curr, User, Gr, NewQ);
 	{'EXIT',Iport,_R} ->
-	    server_loop(Iport, Oport, Curr, User, Gr);
+	    server_loop(Iport, Oport, Curr, User, Gr, IOQueue);
 	{'EXIT',Oport,_R} ->
-	    server_loop(Iport, Oport, Curr, User, Gr);
+	    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, {}));
+	    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 ,
@@ -213,18 +218,51 @@ server_loop(Iport, Oport, Curr, User, Gr) ->
 			    {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);
+			    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)
+			    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))
+		    server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue)
 	    end;
 	_X ->
 	    %% Ignore unknown messages.
-	    server_loop(Iport, Oport, Curr, User, Gr)
+	    server_loop(Iport, Oport, Curr, User, Gr, IOQueue)
+    end.
+
+%% We always handle geometry and unicode requests
+handle_req({Curr,tty_geometry},Iport,_Oport,IOQueue) ->
+    Curr ! {self(),tty_geometry,get_tty_geometry(Iport)},
+    IOQueue;
+handle_req({Curr,get_unicode_state},Iport,_Oport,IOQueue) ->
+    Curr ! {self(),get_unicode_state,get_unicode_state(Iport)},
+    IOQueue;
+handle_req({Curr,set_unicode_state, Bool},Iport,_Oport,IOQueue) ->
+    Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)},
+    IOQueue;
+handle_req(next,Iport,Oport,IOQueue) ->
+    case queue:out(IOQueue) of
+        {{value,Next},ExecQ} ->
+            NewQ = handle_req(Next,Iport,Oport,queue:new()),
+            queue:join(NewQ,ExecQ);
+        {empty,_} ->
+            IOQueue
+    end;
+handle_req(Msg,Iport,Oport,IOQueue) ->
+    case queue:peek(IOQueue) of
+        empty ->
+            {Origin,Req} = Msg,
+            case io_request(Req, Iport, Oport) of
+                ok -> IOQueue;
+                Reply ->
+                    %% Push reply info to front of queue
+                    queue:in_r({Origin,Reply},IOQueue)
+            end;
+        _Else ->
+            %% All requests are queued when we have outstanding sync put_chars
+            queue:in(Msg,IOQueue)
     end.
 
 %% port_bytes(Bytes, InPort, OutPort, CurrentProcess, UserProcess, Group)
@@ -232,34 +270,34 @@ server_loop(Iport, Oport, Curr, User, Gr) ->
 %%  either escape to switch_loop or restart the shell. Otherwise send 
 %%  the bytes to Curr.
 
-port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr) ->
-    handle_escape(Iport, Oport, User, Gr);
+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) ->
-    interrupt_shell(Iport, Oport, Curr, User, Gr);
+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) ->
+port_bytes([B], Iport, Oport, Curr, User, Gr, IOQueue) ->
     Curr ! {self(),{data,[B]}},
-    server_loop(Iport, Oport, Curr, User, Gr);
-port_bytes(Bs, Iport, Oport, Curr, User, Gr) ->
+    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);
+	    handle_escape(Iport, Oport, User, Gr, IOQueue);
 	false ->
 	    Curr ! {self(),{data,Bs}},
-	    server_loop(Iport, Oport, Curr, User, Gr)
+	    server_loop(Iport, Oport, Curr, User, Gr, IOQueue)
     end.
 
-interrupt_shell(Iport, Oport, Curr, User, Gr) ->
+interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue) ->
     case gr_get_info(Gr, Curr) of
 	undefined -> 
 	    ok;					% unknown
 	_ ->
 	    exit(Curr, interrupt)
     end,
-    server_loop(Iport, Oport, Curr, User, Gr).
+    server_loop(Iport, Oport, Curr, User, Gr, IOQueue).
 
-handle_escape(Iport, Oport, User, Gr) ->
+handle_escape(Iport, Oport, User, Gr, IOQueue) ->
     case application:get_env(stdlib, shell_esc) of
 	{ok,abort} ->
 	    Pid = gr_cur_pid(Gr),
@@ -278,11 +316,11 @@ handle_escape(Iport, Oport, User, Gr) ->
 	    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,[]}));
+			gr_add_cur(Gr1, Pid1, {shell,start,[]}), IOQueue);
 
 	_ ->					% {ok,jcl} | undefined
 	    io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport),
-	    server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr))
+	    server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue)
     end.
 
 switch_loop(Iport, Oport, Gr) ->
@@ -492,9 +530,12 @@ set_unicode_state(Iport, Bool) ->
 
 io_request(Request, Iport, Oport) ->
     try io_command(Request) of
-        Command ->
+        {command,_} = Command ->
             Oport ! {self(),Command},
-            ok
+            ok;
+        {Command,Reply} ->
+            Oport ! {self(),Command},
+            Reply
     catch
         {requests,Rs} ->
             io_requests(Rs, Iport, Oport);
@@ -511,6 +552,13 @@ io_requests([], _Iport, _Oport) ->
 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()).
+io_command({put_chars_sync, unicode,Cs,Reply}) ->
+    {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply};
 io_command({put_chars, unicode,Cs}) ->
     {command,[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)]};
 io_command({move_rel,N}) ->