diff options
author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
---|---|---|
committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/ssh/examples/ssh_sample_cli.erl | |
download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/ssh/examples/ssh_sample_cli.erl')
-rw-r--r-- | lib/ssh/examples/ssh_sample_cli.erl | 353 |
1 files changed, 353 insertions, 0 deletions
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(_, _) -> []. |