The R13B03 release.OTP_R13B03

2 files changed, 429 insertions, 0 deletions

diff --git a/lib/ssh/examples/Makefile b/lib/ssh/examples/Makefile
new file mode 100644
index 0000000000..cd8b3c797a
--- /dev/null
+++ b/lib/ssh/examples/Makefile
@@ -0,0 +1,76 @@
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 2005-2009. 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
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(SSH_VSN)
+
+# ----------------------------------------------------
+# Release Macros
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/ssh-$(VSN)
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+
+
+MODULES = \
+	ssh_sample_cli
+
+ERL_FILES= $(MODULES:=.erl)
+
+# TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+TARGET_FILES = $(MODULES:=.beam)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += -pa ../ebin -I ../src
+EBIN = .
+
+# ----------------------------------------------------
+# Make Rules
+# ----------------------------------------------------
+debug opt: $(TARGET_FILES)
+
+debug: ERLC_FLAGS += -Ddebug
+
+clean:
+	rm -f $(TARGET_FILES) *~ *.beam
+
+docs:
+
+# ----------------------------------------------------
+# Release Targets
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+	$(INSTALL_DIR) $(RELSYSDIR)/examples
+	$(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/examples
+
+release_docs_spec:
+
diff --git a/lib/ssh/examples/ssh_sample_cli.erl b/lib/ssh/examples/ssh_sample_cli.erl
new file mode 100644
index 0000000000..2505c1b759
--- /dev/null
+++ b/lib/ssh/examples/ssh_sample_cli.erl
@@ -0,0 +1,353 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2005-2009. 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
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssh_sample_cli).
+
+%% api
+-export([listen/1, listen/2]).
+
+%% %% our shell function
+%% -export([start_our_shell/1]).
+
+%% our command functions
+-export([cli_prime/1, cli_primes/1, cli_gcd/2, cli_lcm/2,
+	 cli_factors/1, cli_exit/0, cli_rho/1, cli_help/0,
+	 cli_crash/0, cli_users/0, cli_self/0,
+	 cli_user/0, cli_host/0]).
+
+%% imports
+-import(lists, [reverse/1, reverse/2, seq/2, prefix/2]).
+-import(math, [sqrt/1]).
+
+
+listen(Port) ->
+    listen(Port, []).
+
+listen(Port, Options) ->
+    ssh_cli:listen(fun(U, H) -> start_our_shell(U, H) end, Port, Options).
+
+%% our_routines
+our_routines() ->
+    [
+     {"crash", cli_crash,    "            crash the cli"},
+     {"exit", cli_exit,      "            exit application"},
+     {"factors", cli_factors,"<int>       prime factors of <int>"},
+     {"gcd", cli_gcd,        "<int> <int> greatest common divisor"},
+     {"help", cli_help,      "            help text"},
+     {"lcm", cli_lcm,        "<int> <int> least common multiplier"},
+     {"prime", cli_prime,    "<int>       check for primality"},
+     {"primes", cli_primes,  "<int>       print all primes up to <int>"},
+     {"rho", cli_rho,        "<int>       prime factors using rho's alg."},
+     {"who",  cli_users,     "            lists users"},
+     {"user", cli_user,      "            print name of user"},
+     {"host", cli_host,      "            print host addr"},
+     {"self", cli_self,      "            print my pid"}
+    ].
+
+%% (we could of course generate this from module_info() something like this)
+%% our_routines1() ->
+%%     {value, {exports, Exports}} =
+%% 	lists:keysearch(exports, 1, module_info()),
+%%     get_cli(Exports, []).
+
+%% our_args1(N) -> our_args1(N, "").
+%% our_args1(0, S) -> S;
+%% our_args1(N, S) -> our_args1(N-1, S ++ "<int> ").
+
+%% get_cli([], Acc) ->
+%%     lists:sort(Acc);
+%% get_cli([{A, Arity} | Rest], Acc) ->
+%%     L = atom_to_list(A),
+%%     case lists:prefix("cli_", L) of
+%% 	true -> get_cli(Rest, [{tl4(L), A, our_args1(Arity)} | Acc]);
+%% 	false -> get_cli(Rest, Acc)
+%%     end.
+
+%% the longest common prefix of two strings
+common_prefix([C | R1], [C | R2], Acc) ->
+    common_prefix(R1, R2, [C | Acc]);
+common_prefix(_, _, Acc) ->
+    reverse(Acc).
+
+%% longest prefix in a list, given a prefix
+longest_prefix(List, Prefix) ->
+    case [A || {A, _, _} <- List, prefix(Prefix, A)] of
+	[] ->
+	    {none, List};
+	[S | Rest] ->
+	    NewPrefix0 =
+		lists:foldl(fun(A, P) ->
+				    common_prefix(A, P, [])
+			    end, S, Rest),
+	    NewPrefix = nthtail(length(Prefix), NewPrefix0),
+	    {prefix, NewPrefix, [S | Rest]}
+    end.			
+
+%%% our expand function (called when the user presses TAB)
+%%% input: a reversed list with the row to left of the cursor
+%%% output: {yes|no, Expansion, ListofPossibleMatches}
+%%% where the atom no yields a beep
+%%% Expansion is a string inserted at the cursor
+%%% List... is a list that will be printed
+%%% Here we beep on prefixes that don't match and when the command
+%%% filled in
+expand([$  | _]) ->
+    {no, "", []};
+expand(RevBefore) ->    
+    Before = reverse(RevBefore),
+    case longest_prefix(our_routines(), Before) of
+	{prefix, P, [_]} ->
+	    {yes, P ++ " ", []};
+	{prefix, "", M} ->
+	    {yes, "", M};
+	{prefix, P, _M} ->
+	    {yes, P, []};
+	{none, _M} ->
+	    {no, "", []}
+    end.
+
+%%% spawns out shell loop, we use plain io to input and output
+%%% over ssh (the group module is our group leader, and takes
+%%% care of sending input to the ssh_sample_cli server)
+start_our_shell(User, Peer) ->
+    spawn(fun() ->
+		  io:setopts([{expand_fun, fun(Bef) -> expand(Bef) end}]),
+		  io:format("Enter command\n"),
+		  put(user, User),
+		  put(peer_name, Peer),
+		  our_shell_loop()
+	  end).
+
+%%% an ordinary Read-Eval-Print-loop
+our_shell_loop() ->
+    % Read
+    Line = io:get_line({format, "CLI> ", []}),
+    % Eval
+    Result = eval_cli(Line),
+    % Print
+    io:format("---> ~p\n", [Result]),
+    case Result of
+	done -> exit(normal);
+	crash -> 1 / 0;
+	_ -> our_shell_loop()
+    end.
+
+%%% translate a command to a function
+command_to_function(Command) ->
+    case lists:keysearch(Command, 1, our_routines()) of
+	{value, {_, Proc, _}} -> Proc;
+	false -> unknown_cli
+    end.
+
+%%% evaluate a command line
+eval_cli(Line) ->
+    case string:tokens(Line, " \n") of
+	[] -> [];
+	[Command | ArgStrings] ->
+	    Proc = command_to_function(Command),
+	    case fix_args(ArgStrings) of
+		{ok, Args} ->
+		    case catch apply(?MODULE, Proc, Args) of
+			{'EXIT', Error} ->
+			    {error, Error}; % wrong_number_of_arguments};
+			Result ->
+			    Result
+		    end;
+		Error ->
+		    Error
+	    end
+    end.
+
+%%% make command arguments to integers
+fix_args(ArgStrings) ->
+    case catch [list_to_integer(A) || A <- ArgStrings] of
+	{'EXIT', _} ->
+	    {error, only_integer_arguments};
+	Args ->
+	    {ok, Args}
+    end.
+		     
+%%% the commands, check for reasonable arguments here too
+cli_prime(N) when N < 1000000000 ->
+    rho(N) == [N] andalso is_prime(N);
+cli_prime(N) when N < 10000 ->
+    is_prime(N).
+
+cli_primes(N) when N < 1000000 ->
+    primes(N).
+
+cli_gcd(A, B) when is_integer(A), is_integer(B) ->
+    gcd(A, B).
+
+cli_lcm(A, B) when is_integer(A), is_integer(B) ->
+    lcm(A, B).
+
+cli_factors(A) when A < 1000000 ->
+    factors(A).
+
+cli_user() ->
+    get(user).
+
+cli_host() ->
+    get(peer_name).
+
+cli_users() ->
+    case ssh_userauth:get_auth_users() of
+	{ok, UsersPids} ->
+	    UsersPids; % [U || {U, _} <- UsersPids];
+	E ->
+	    E
+    end.
+
+cli_self() ->
+    self().
+
+cli_crash() ->
+    crash.
+    
+cli_rho(A) ->
+    rho(A).
+
+cli_exit() ->
+    done.
+
+help_str(L) ->
+    help_str(L, []).
+help_str([], Acc) ->
+    lists:sort(Acc);
+help_str([{CommandName, _, HelpS} | Rest], Acc) ->
+    C = string:left(CommandName, 10),
+    help_str(Rest, [[C, " ", HelpS, $\n] | Acc]).
+
+cli_help() ->
+    HelpString = ["CLI Sample\n" | help_str(our_routines())],
+    io:format("~s\n", [HelpString]).
+
+%% a quite simple Sieve of Erastothenes (not tail-recursive, though)
+primes(Size) ->
+    era(sqrt(Size), seq(2,Size)).
+
+era(Max, [H|T]) when H =< Max ->
+    [H | era(Max, sieve([H|T], H))];
+era(_Max, L) -> 
+    L.
+
+sieve([H|T], N) when H rem N =/= 0 ->
+    [H | sieve(T, N)];
+sieve([_H|T], N) ->
+    sieve(T, N);
+sieve([], _N) ->
+    [].
+
+%% another sieve, for getting the next prime incrementally
+next_prime([], _) ->
+    2;
+next_prime([2], 2) ->
+    3;
+next_prime(Primes, P) ->
+    next_prime1(Primes, P).
+
+next_prime1(Primes, P) ->
+    P1 = P + 2,
+    case divides(Primes, trunc(sqrt(P1)), P1) of
+	false -> P1;
+	true -> next_prime1(Primes, P1)
+    end.
+
+divides([], _, _) ->
+    false;
+divides([A | _], Nsqrt, _) when A > Nsqrt ->
+    false;
+divides([A | _], _, N) when N rem A == 0 ->
+    true;
+divides([_ | R], Nsqrt, N) ->
+    divides(R, Nsqrt, N).
+
+is_prime(P) ->
+    lists:all(fun(A) -> P rem A =/= 0 end, primes(trunc(sqrt(P)))).
+
+%% Normal gcd, Euclid
+gcd(R, Q) when abs(Q) < abs(R) -> gcd1(Q,R);
+gcd(R, Q) -> gcd1(R,Q).
+
+gcd1(0, Q) -> Q;
+gcd1(R, Q) ->
+    gcd1(Q rem R, R).
+
+%% Least common multiple of (R,Q)
+lcm(0, _Q) -> 0;
+lcm(_R, 0) -> 0;
+lcm(R, Q) ->
+    (Q div gcd(R, Q)) * R.
+
+%%% Prime factors of a number (na�ve implementation)
+factors(N) ->
+    Nsqrt = trunc(sqrt(N)),
+    factors([], N, 2, Nsqrt, []).
+    
+factors(_Primes, N, Prime, Nsqrt, Factors) when Prime > Nsqrt ->
+    reverse(Factors, [N]);
+factors(Primes, N, Prime, Nsqrt, Factors) ->
+    case N rem Prime of
+	0 ->
+	    %%io:format("factor ------- ~p\n", [Prime]),
+	    N1 = N div Prime,
+	    factors(Primes, N1, Prime, trunc(sqrt(N1)), [Prime|Factors]);
+	_ ->
+	    Primes1 = Primes ++ [Prime],
+	    Prime1 = next_prime(Primes1, Prime),
+	    factors(Primes1, N, Prime1, Nsqrt, Factors)
+    end.
+
+%%% Prime factors using Rho's algorithm ("reminded" from wikipedia.org)
+%%% (should perhaps have used Brent instead, but it's not as readable)
+rho_pseudo(X, C, N) ->
+    (X * X + C) rem N.
+
+rho(N) when N > 1000 ->
+    case rho(2, 2, 1, N, fun(X) -> rho_pseudo(X, 1, N) end) of
+	failure ->
+	    [N];
+	F ->
+	    lists:sort(rho(F) ++ rho(N div F))
+    end;
+rho(N) ->
+    factors(N).
+
+rho(X, Y, 1, N, Pseudo) ->
+    X1 = Pseudo(X),
+    Y1 = Pseudo(Pseudo(Y)),
+    D = gcd(absdiff(X1, Y1), N),
+    rho(X1, Y1, D, N, Pseudo);
+rho(_X, _Y, D, N, _Pseudo) when 1 < D, D < N ->
+    D;
+rho(_X, _Y, D, N, _Pseudo) when D == N ->
+    failure.
+    
+absdiff(A, B) when A > B ->
+    A - B;
+absdiff(A, B) ->
+    B - A.
+
+%%% nthtail as in lists, but no badarg if n > the length of list
+nthtail(0, A) -> A;
+nthtail(N, [_ | A]) -> nthtail(N-1, A);
+nthtail(_, _) -> [].