Merge branch 'ia/ssh/pty-request/OTP-11542' into maint

* ia/ssh/pty-request/OTP-11542:
  ssh: Add basic ptty_alloc tests
  ssh: Add pty_alloc request to ssh:shell/[1,2,3]
  ssh: Add ptty_alloc/[2,3]

6 files changed, 195 insertions, 50 deletions

diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml
index 72e7252536..ff72cf7ee0 100644
--- a/lib/ssh/doc/src/ssh_connection.xml
+++ b/lib/ssh/doc/src/ssh_connection.xml
@@ -5,7 +5,7 @@
   <header>
     <copyright>
       <year>2008</year>
-      <year>2013</year>
+      <year>2014</year>
       <holder>Ericsson AB, All Rights Reserved</holder>
     </copyright>
     <legalnotice>
@@ -137,7 +137,7 @@
 
 	 <tag><c><![CDATA[{pty, ssh_channel_id(),
 	 boolean() = WantReply, {string() = Terminal, integer() = CharWidth,
-	 integer() = RowHeight, integer() = PixelWidth, integer() = PixelHight,
+	 integer() = RowHeight, integer() = PixelWidth, integer() = PixelHeight,
 	 [{atom() | integer() = Opcode,
 	 integer() = Value}] = TerminalModes}}]]></c></tag>
 	 <item>A pseudo-terminal has been requested for the
@@ -148,11 +148,11 @@
 	 drawable area of the window. The <c>Opcode</c> in the
 	 <c>TerminalModes</c> list is the mnemonic name, represented
 	 as an lowercase erlang atom, defined in
-	 <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254  </url> section 8,
-	 or the opcode if the mnemonic name is not listed in the
+	 <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254  </url> section 8.
+	 It may also be an opcode if the mnemonic name is not listed in the
 	 RFC. Example <c>OP code: 53, mnemonic name ECHO erlang atom:
-	 echo</c>. There is currently no API function to generate this
-	 event.</item>
+	 echo</c>.This event is sent as result of calling <seealso
+	 marker="ssh_connection#ptty_alloc/4">ssh_connection:ptty_alloc/4</seealso></item>
 
 	 <tag><c><![CDATA[{shell, boolean() = WantReply}]]></c></tag>
 	 <item> This message will request that the user's default shell
@@ -273,7 +273,52 @@
      </desc>
    </func>
    
-     <func>
+   <func>
+       <name>ptty_alloc(ConnectionRef, ChannelId, Options, Timeout) -> success | failure</name>
+       <fsummary>Send status replies to requests that want such replies. </fsummary>
+      <type>
+	<v> ConnectionRef = ssh_connection_ref() </v>
+	<v> ChannelId = ssh_channel_id()</v>
+	<v> Options = proplists:proplist()</v>
+      </type>
+      <desc>
+	<p> Sends a SSH Connection Protocol pty_req, to allocate a pseudo tty.
+	Should be called by a SSH client process.
+	Options are:
+	</p>
+
+	<taglist>
+	  <tag>{term, string()}</tag>
+	  <item>
+	    Defaults to os:getenv("TERM") or "vt100" if it is undefined. 
+	  </item>
+	  <tag>{width, integer()}</tag>
+	  <item>
+	    Defaults to 80 if pixel_width is not defined.
+	  </item>
+	  <tag>{height, integer()}</tag>
+	  <item>
+	    Defaults to 24 if pixel_height is not defined.
+	  </item>
+	  <tag>{pixel_width, integer()}</tag>
+	  <item>
+	    Is disregarded if width is defined.
+	  </item>
+	  <tag>{pixel_height, integer()}</tag>
+	  <item>
+	    Is disregarded if height is defined.
+	  </item>
+	  <tag>{pty_opts, [{posix_atom(), integer()}]}</tag>
+	  <item>
+	    Option may be an empty list, otherwise
+	    see possible POSIX names in section 8 in <url href="http://www.ietf.org/rfc/rfc4254.txt"> RFC 4254</url>.
+	  </item>
+	 </taglist>
+
+      </desc>
+     </func>
+
+   <func>
        <name>reply_request(ConnectionRef, WantReply, Status, ChannelId) -> ok</name>
        <fsummary>Send status replies to requests that want such replies. </fsummary>
       <type>
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index de047d3c83..eae33e3683 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -194,6 +194,7 @@ shell(Host, Port, Options) ->
 	{ok, ConnectionRef} ->
 	    case ssh_connection:session_channel(ConnectionRef, infinity) of
 		{ok,ChannelId}  ->
+		    success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, []),
 		    Args = [{channel_cb, ssh_shell}, 
 			    {init_args,[ConnectionRef, ChannelId]},
 			    {cm, ConnectionRef}, {channel_id, ChannelId}],
diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl
index 9307dbbad0..d14f7ce27d 100644
--- a/lib/ssh/src/ssh_connect.hrl
+++ b/lib/ssh/src/ssh_connect.hrl
@@ -165,6 +165,10 @@
 	  recipient_channel
 	 }).
 
+-define(TERMINAL_WIDTH, 80).
+-define(TERMINAL_HEIGHT, 24).
+-define(DEFAULT_TERMINAL, "vt100").
+
 -define(TTY_OP_END,0).  %% Indicates end of options.
 -define(VINTR,1).       %% Interrupt character; 255 if none. Similarly for the
 			%% other characters. Not all of these characters are
diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl
index f3ff9ae67a..593443e11c 100644
--- a/lib/ssh/src/ssh_connection.erl
+++ b/lib/ssh/src/ssh_connection.erl
@@ -32,11 +32,11 @@
 %% API
 -export([session_channel/2, session_channel/4,
 	 exec/4, shell/2, subsystem/4, send/3, send/4, send/5, 
-	 send_eof/2, adjust_window/3, setenv/5, close/2, reply_request/4]).
+	 send_eof/2, adjust_window/3, setenv/5, close/2, reply_request/4,
+	 ptty_alloc/3, ptty_alloc/4]).
 
 %% Potential API currently unsupported and not tested
--export([open_pty/3, open_pty/7,
-	 open_pty/9, window_change/4, window_change/6,
+-export([window_change/4, window_change/6,
 	 direct_tcpip/6, direct_tcpip/8, tcpip_forward/3,
 	 cancel_tcpip_forward/3, signal/3, exit_status/3]).
 
@@ -189,6 +189,25 @@ reply_request(_,false, _, _) ->
     ok.
 
 %%--------------------------------------------------------------------
+-spec ptty_alloc(pid(), channel_id(), proplists:proplist()) -> success | failiure.
+%%
+%%
+%% Description: Sends a ssh connection protocol pty_req.
+%%--------------------------------------------------------------------
+ptty_alloc(ConnectionHandler, Channel, Options) ->
+    ptty_alloc(ConnectionHandler, Channel, Options, infinity).
+ptty_alloc(ConnectionHandler, Channel, Options, TimeOut) ->
+    {Width, PixWidth} = pty_default_dimensions(width, Options),
+    {Hight, PixHight} = pty_default_dimensions(hight, Options),
+    pty_req(ConnectionHandler, Channel,
+	    proplists:get_value(term, Options, default_term()),
+	    proplists:get_value(width, Options, Width),
+	    proplists:get_value(hight, Options, Hight),
+	    proplists:get_value(pixel_widh, Options, PixWidth),
+	    proplists:get_value(pixel_hight, Options, PixHight),
+	    proplists:get_value(pty_opts, Options, []), TimeOut
+	   ).
+%%--------------------------------------------------------------------
 %% Not yet officialy supported! The following functions are part of the
 %% initial contributed ssh application. They are untested. Do we want them?
 %% Should they be documented and tested?
@@ -211,23 +230,6 @@ exit_status(ConnectionHandler, Channel, Status) ->
     ssh_connection_handler:request(ConnectionHandler, Channel,
 				   "exit-status", false, [?uint32(Status)], 0).
 
-open_pty(ConnectionHandler, Channel, TimeOut) ->
-    open_pty(ConnectionHandler, Channel,
-	     os:getenv("TERM"), 80, 24, [], TimeOut).
-
-open_pty(ConnectionHandler, Channel, Term, Width, Height, PtyOpts, TimeOut) ->
-    open_pty(ConnectionHandler, Channel, Term, Width,
-	     Height, 0, 0, PtyOpts, TimeOut).
-
-open_pty(ConnectionHandler, Channel, Term, Width, Height,
-	 PixWidth, PixHeight, PtyOpts, TimeOut) ->
-    ssh_connection_handler:request(ConnectionHandler,
-				   Channel, "pty-req", true, 
-				   [?string(Term),
-				    ?uint32(Width), ?uint32(Height),
-				    ?uint32(PixWidth),?uint32(PixHeight),
-				    encode_pty_opts(PtyOpts)], TimeOut).
-
 direct_tcpip(ConnectionHandler, RemoteHost,
 	     RemotePort, OrigIP, OrigPort, Timeout) ->
     direct_tcpip(ConnectionHandler, RemoteHost, RemotePort, OrigIP, OrigPort,
@@ -1080,6 +1082,27 @@ flow_control([_|_], #channel{flow_control = From,
 flow_control(_,_,_) ->
 	[].
 
+pty_req(ConnectionHandler, Channel, Term, Width, Height,
+	 PixWidth, PixHeight, PtyOpts, TimeOut) ->
+    ssh_connection_handler:request(ConnectionHandler,
+				   Channel, "pty-req", true,
+				   [?string(Term),
+				    ?uint32(Width), ?uint32(Height),
+				    ?uint32(PixWidth),?uint32(PixHeight),
+				    encode_pty_opts(PtyOpts)], TimeOut).
+
+pty_default_dimensions(Dimension, Options) ->
+    case proplists:get_value(Dimension, Options, 0) of
+	N when is_integer(N), N > 0 ->
+	    {N, 0};
+	_ ->
+	    case proplists:get_value(list_to_atom("pixel_" ++ atom_to_list(Dimension)), Options, 0) of
+		N when is_integer(N), N > 0 ->
+		    {0, N};
+		_ ->
+		    {?TERMINAL_WIDTH, 0}
+	    end
+    end.
 
 encode_pty_opts(Opts) ->
     Bin = list_to_binary(encode_pty_opts2(Opts)),
@@ -1277,3 +1300,10 @@ decode_ip(Addr) when is_binary(Addr) ->
 	{ok,A}    -> A
     end.
 
+default_term() ->
+    case os:getenv("TERM") of
+	false ->
+	    ?DEFAULT_TERMINAL;
+	Str when is_list(Str)->
+	    Str
+    end.	
diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl
index 3c537d719c..553d0f5720 100644
--- a/lib/ssh/test/ssh_connection_SUITE.erl
+++ b/lib/ssh/test/ssh_connection_SUITE.erl
@@ -36,7 +36,7 @@
 
 all() ->
     [
-     {group, openssh_payload},
+     {group, openssh},
      start_subsystem_on_closed_channel,
      interrupted_send,
      start_shell,
@@ -49,11 +49,19 @@ all() ->
      stop_listener
     ].
 groups() ->
-    [{openssh_payload, [], [simple_exec,
-			    small_cat,
-			    big_cat,
-			    send_after_exit
-			   ]}].
+    [{openssh, [], payload() ++ ptty()}].
+
+payload() ->
+    [simple_exec,
+     small_cat,
+     big_cat,
+     send_after_exit].
+
+ptty() ->
+    [ptty_alloc_default,
+     ptty_alloc,
+     ptty_alloc_pixel].
+
 %%--------------------------------------------------------------------
 init_per_suite(Config) ->
     case catch crypto:start() of
@@ -67,7 +75,7 @@ end_per_suite(_Config) ->
     crypto:stop().
 
 %%--------------------------------------------------------------------
-init_per_group(openssh_payload, _Config) ->
+init_per_group(openssh, _Config) ->
     case gen_tcp:connect("localhost", 22, []) of
 	{error,econnrefused} ->
 	    {skip,"No openssh deamon"};
@@ -242,6 +250,42 @@ send_after_exit(Config) when is_list(Config) ->
     end.
 
 %%--------------------------------------------------------------------
+ptty_alloc_default() ->
+    [{doc, "Test sending PTTY alloc message with only defaults."}].
+
+ptty_alloc_default(Config) when is_list(Config) ->
+    ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true},
+							     {user_interaction, false}]),
+    {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
+    success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, []),
+    ssh:close(ConnectionRef).
+
+%%--------------------------------------------------------------------
+ptty_alloc() ->
+    [{doc, "Test sending PTTY alloc message with width,height options."}].
+
+ptty_alloc(Config) when is_list(Config) ->
+    ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true},
+							     {user_interaction, false}]),
+    {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
+    success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, 
+					[{term, default_term()}, {width, 70}, {high, 20}]),
+    ssh:close(ConnectionRef).
+
+
+%%--------------------------------------------------------------------
+ptty_alloc_pixel() ->
+    [{doc, "Test sending PTTY alloc message pixel options."}].
+
+ptty_alloc_pixel(Config) when is_list(Config) ->
+    ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true},
+							     {user_interaction, false}]),
+    {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
+    success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, 
+					[{term, default_term()}, {pixel_widh, 630}, {pixel_hight, 470}]),
+    ssh:close(ConnectionRef).
+
+%%--------------------------------------------------------------------
 start_subsystem_on_closed_channel(Config) ->
     PrivDir = ?config(priv_dir, Config),
     UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
@@ -603,3 +647,11 @@ ssh_exec(Cmd) ->
     spawn(fun() ->
 		  io:format(Cmd ++ "\n")
           end).
+
+default_term() ->
+    case os:getenv("TERM") of
+	false ->
+	    "vt100";
+	Str when is_list(Str)->
+	    Str
+    end.	
diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl
index 41fbd324c4..af70eeb46c 100644
--- a/lib/ssh/test/ssh_to_openssh_SUITE.erl
+++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl
@@ -120,13 +120,8 @@ erlang_shell_client_openssh_server(Config) when is_list(Config) ->
     receive_hej(),
     IO ! {input, self(), "exit\n"},
     receive_logout(),
-    receive
-	{'EXIT', Shell, normal} ->
-	    ok;
-	Other1 ->
-	    ct:fail({unexpected_msg, Other1})
-    end.
-
+    receive_normal_exit(Shell).
+   
 %--------------------------------------------------------------------
 erlang_client_openssh_server_exec() ->
     [{doc, "Test api function ssh_connection:exec"}].
@@ -529,11 +524,22 @@ erlang_client_openssh_server_nonexistent_subsystem(Config) when is_list(Config)
 %%--------------------------------------------------------------------
 receive_hej() ->
     receive
-	<<"Hej\n">> = Hej->
+	<<"Hej", _binary>> = Hej ->
+	    ct:pal("Expected result: ~p~n", [Hej]);
+	<<"Hej\n", _binary>> = Hej ->
+	    ct:pal("Expected result: ~p~n", [Hej]);
+	<<"Hej\r\n", _/binary>> = Hej ->
 	    ct:pal("Expected result: ~p~n", [Hej]);
 	Info ->
-	    ct:pal("Extra info: ~p~n", [Info]),
-	    receive_hej()
+	    Lines = binary:split(Info, [<<"\r\n">>], [global]),
+	    case lists:member(<<"Hej">>, Lines) of
+		true ->
+		    ct:pal("Expected result found in lines: ~p~n", [Lines]),
+		    ok;
+		false ->
+		    ct:pal("Extra info: ~p~n", [Info]),
+		    receive_hej()
+	    end
     end.
 
 receive_logout() ->
@@ -543,13 +549,20 @@ receive_logout() ->
 		<<"Connection closed">> ->
 		    ok
 	    end;
-	<<"TERM environment variable not set.\n">> -> %% Windows work around
-	    receive_logout();
-	Other0 ->
-	    ct:fail({unexpected_msg, Other0})
-    end.
-
+	Info ->
+	    ct:pal("Extra info when logging out: ~p~n", [Info]),
+	    receive_logout()
+	end.
 
+receive_normal_exit(Shell) ->
+    receive
+	{'EXIT', Shell, normal} ->
+	    ok;
+	<<"\r\n">> ->
+	    receive_normal_exit(Shell);
+	Other ->
+	    ct:fail({unexpected_msg, Other})
+    end.
 
 %%--------------------------------------------------------------------
 %%--------------------------------------------------------------------