ssh: Add ptty_alloc/[2,3]

3 files changed, 107 insertions, 28 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_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 87f37b93ef..593443e11c 100644
--- a/lib/ssh/src/ssh_connection.erl
+++ b/lib/ssh/src/ssh_connection.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
 %%
 %% The contents of this file are subject to the Erlang Public License,
 %% Version 1.1, (the "License"); you may not use this file except in
@@ -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.