aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server/src
diff options
context:
space:
mode:
authorBjörn-Egil Dahlberg <egil@erlang.org>2012-07-17 19:15:09 +0200
committerBjörn-Egil Dahlberg <egil@erlang.org>2012-07-19 20:22:54 +0200
commit1fc645451d1d32db120fae5bcefd4c6653ca4f41 (patch)
treede8bfe64d3229dd92f1d9378bc5e40d1234d2f5b /lib/test_server/src
parentc6266995b9e007af4b48db8de1ddbaa7ced912fe (diff)
downloadotp-1fc645451d1d32db120fae5bcefd4c6653ca4f41.tar.gz
otp-1fc645451d1d32db120fae5bcefd4c6653ca4f41.tar.bz2
otp-1fc645451d1d32db120fae5bcefd4c6653ca4f41.zip
test_server: Remove VxWorks
Diffstat (limited to 'lib/test_server/src')
-rw-r--r--lib/test_server/src/Makefile4
-rw-r--r--lib/test_server/src/test_server.erl6
-rw-r--r--lib/test_server/src/test_server_ctrl.erl8
-rw-r--r--lib/test_server/src/test_server_internal.hrl2
-rw-r--r--lib/test_server/src/test_server_node.erl43
-rw-r--r--lib/test_server/src/ts.erl7
-rw-r--r--lib/test_server/src/ts_autoconf_vxworks.erl191
-rw-r--r--lib/test_server/src/ts_erl_config.erl12
-rw-r--r--lib/test_server/src/ts_install.erl6
-rw-r--r--lib/test_server/src/ts_run.erl4
-rw-r--r--lib/test_server/src/vxworks_client.erl243
11 files changed, 10 insertions, 516 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile
index a75855eaab..3106f28d0f 100644
--- a/lib/test_server/src/Makefile
+++ b/lib/test_server/src/Makefile
@@ -44,8 +44,7 @@ MODULES= test_server_ctrl \
test_server \
test_server_sup \
test_server_h \
- erl2html2 \
- vxworks_client
+ erl2html2
TS_MODULES= \
ts \
@@ -55,7 +54,6 @@ TS_MODULES= \
ts_make \
ts_erl_config \
ts_autoconf_win32 \
- ts_autoconf_vxworks \
ts_install \
ts_install_cth
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 6e94e4861a..1b8221e73c 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -2118,14 +2118,10 @@ timetrap_scale_factor() ->
{false,true} -> 2 * F0;
{false,false} -> F0
end,
- F2 = case has_superfluous_schedulers() of
+ F = case has_superfluous_schedulers() of
true -> 3*F1;
false -> F1
end,
- F = case test_server_sup:get_os_family() of
- vxworks -> 5 * F2;
- _ -> F2
- end,
case test_server:is_cover() of
true -> 10 * F;
false -> F
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 5ed296d215..803406bcb2 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -429,14 +429,6 @@ run_test(CommandLine) ->
testcase_callback(TCCB),
add_job(Name, {command_line,SpecList}),
- %% adding of jobs involves file i/o which may take long time
- %% when running a nfs mounted file system (VxWorks).
- case controller_call(get_target_info) of
- #target_info{os_family=vxworks} ->
- receive after 30000 -> ready_to_wait end;
- _ ->
- wait_now
- end,
wait_finish().
%% Converted CoverFile to a string unless it is 'none'
diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl
index c9c52854e3..b58b42805e 100644
--- a/lib/test_server/src/test_server_internal.hrl
+++ b/lib/test_server/src/test_server_internal.hrl
@@ -25,7 +25,7 @@
%% test_server_ctrl:contact_main_target/2
%% Once initiated, this information will never change!!
-record(target_info, {where, % local | Socket
- os_family, % atom(); win32 | unix | vxworks | ose
+ os_family, % atom(); win32 | unix
os_type, % result of os:type()
host, % string(); the name of the target machine
version, % string()
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
index 6358efa764..17c02dfbe5 100644
--- a/lib/test_server/src/test_server_node.erl
+++ b/lib/test_server/src/test_server_node.erl
@@ -35,7 +35,6 @@
-include("test_server_internal.hrl").
-record(slave_info, {name,socket,client}).
--define(VXWORKS_ACCEPT_TIMEOUT,?ACCEPT_TIMEOUT).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% %%%
@@ -72,14 +71,6 @@ start_remote_main_target(Parameters) ->
lists:foreach(fun(T) -> maybe_reboot_target({TargetType,T}) end,
[list_to_atom(TargetHost)|SlaveTargets]),
- % Must give the targets a chance to reboot...
- case TargetType of
- vxworks ->
- receive after 15000 -> ok end;
- _ ->
- ok
- end,
-
Cmd0 = get_main_target_start_command(TargetType,TargetHost,Naming,
MasterNode,MasterCookie),
Cmd =
@@ -462,9 +453,6 @@ start_node_peer(SlaveName, OptList, From, TI) ->
%%
%% Slave nodes are started on a remote host if
%% - the option remote is given when calling test_server:start_node/3
-%% or
-%% - the target type is vxworks, since only one erlang node
-%% can be started on each vxworks host.
%%
start_node_slave(SlaveName, OptList, From, TI) ->
SuppliedArgs = start_node_get_option_value(args, OptList, []),
@@ -787,19 +775,6 @@ kill_node(SI,TI) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Platform specific code
-start_target(vxworks,TargetHost,Cmd) ->
- case vxworks_client:open(TargetHost) of
- {ok,P} ->
- case vxworks_client:send_data(P,Cmd,"start_erl called") of
- {ok,_} ->
- {ok,{vxworks,P},?VXWORKS_ACCEPT_TIMEOUT};
- Error ->
- Error
- end;
- Error ->
- Error
- end;
-
start_target(unix,TargetHost,Cmd0) ->
Cmd =
case test_server_sup:hoststr() of
@@ -809,19 +784,9 @@ start_target(unix,TargetHost,Cmd0) ->
open_port({spawn, Cmd}, [stream]),
{ok,undefined,?ACCEPT_TIMEOUT}.
-maybe_reboot_target({vxworks,P}) when is_pid(P) ->
- %% Reboot the vxworks card.
- %% Client is also closed after this, even if reboot fails
- vxworks_client:send_data_wait_for_close(P,"q");
-maybe_reboot_target({vxworks,T}) when is_atom(T) ->
- %% Reboot the vxworks card.
- %% Client is also closed after this, even if reboot fails
- vxworks_client:reboot(T);
maybe_reboot_target(_) ->
{error, cannot_reboot_target}.
-close_target_client({vxworks,P}) ->
- vxworks_client:close(P);
close_target_client(undefined) ->
ok.
@@ -830,11 +795,6 @@ close_target_client(undefined) ->
%%
%% Command for starting main target
%%
-get_main_target_start_command(vxworks,_TargetHost,Naming,
- _MasterNode,_MasterCookie) ->
- "e" ++ Naming ++ " test_server -boot start_sasl"
- " -sasl errlog_type error"
- " -s test_server start " ++ test_server_sup:hoststr();
get_main_target_start_command(unix,_TargetHost,Naming,
_MasterNode,_MasterCookie) ->
Prog = pick_erl_program(default),
@@ -845,9 +805,6 @@ get_main_target_start_command(unix,_TargetHost,Naming,
%%
%% Command for starting slave nodes
%%
-get_slave_node_start_command(vxworks, _Prog, _MasterNode) ->
- "e";
- %"e-noinput -master " ++ MasterNode;
get_slave_node_start_command(unix, Prog, MasterNode) ->
cast_to_list(Prog) ++ " -detached -master " ++ MasterNode.
diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl
index 4899f38d2b..9241c83fb2 100644
--- a/lib/test_server/src/ts.erl
+++ b/lib/test_server/src/ts.erl
@@ -40,8 +40,8 @@
%%% the modules:
%%%
%%% +-- ts_install --+------ ts_autoconf_win32
-%%% | |
-%%% | +------ ts_autoconf_vxworks
+%%% |
+%%% |
%%% |
%%% ts ---+ +------ ts_erl_config
%%% | | ts_lib
@@ -63,8 +63,7 @@
%%% ts Frontend to the test server framework. Contains all
%%% interface functions.
%%% ts_install Installs the test suite. On Unix, `autoconf' is
-%%% is used; on Windows, ts_autoconf_win32 is used,
-%%% on VxWorks, ts_autoconf_vxworks is used.
+%%% is used; on Windows, ts_autoconf_win32 is used.
%%% The result is written to the file `variables'.
%%% ts_run Supervises running of the tests.
%%% ts_autconf_win32 An `autoconf' for Windows.
diff --git a/lib/test_server/src/ts_autoconf_vxworks.erl b/lib/test_server/src/ts_autoconf_vxworks.erl
deleted file mode 100644
index f4535cd89a..0000000000
--- a/lib/test_server/src/ts_autoconf_vxworks.erl
+++ /dev/null
@@ -1,191 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-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%
-%%
-
-%%% Purpose : Autoconf for cross environments.
-
--module(ts_autoconf_vxworks).
--export([configure/1]).
-%%% Supported cross platforms:
--define(PLATFORMS, ["vxworks_cpu32", "vxworks_ppc860", "vxworks_ppc603",
- "vxworks_sparc", "vxworks_ppc750", "vxworks_simso"]).
--include("ts.hrl").
-
-%% takes an argument {Target_arch, Target_host} (e.g. {vxworks_ppc860, thorin}).
-configure({Target_arch, Target_host}) ->
- case variables({Target_arch, Target_host}) of
- {ok, Vars} ->
- ts_lib:subst_file("conf_vars.in", "conf_vars", Vars);
- Error ->
- Error
- end.
-
-variables(Cross_spec) ->
- run_tests(Cross_spec, tests(), []).
-
-run_tests(Cross_spec, [{Prompt, Tester}|Rest], Vars) ->
- io:format("checking ~s... ", [Prompt]),
- case catch Tester(Cross_spec, Vars) of
- {'EXIT', Reason} ->
- io:format("FAILED~nExit status: ~p~n", [Reason]),
- {error, auto_conf_failed};
- {Result, NewVars} ->
- io:format("~s~n", [lists:concat([Result])]),
- run_tests(Cross_spec, Rest, NewVars)
- end;
-run_tests(_Cross_spec, [], Vars) ->
- {ok, Vars}.
-
-
-%%% The tests.
-
-tests() ->
- [{"supported target architecture", fun target_architecture/2},
- {"cross target host to run tests on", fun target_host/2},
- {"CPU type", fun cpu/2},
- {"for cross-compiling gcc", fun find_gcc/2},
- {"for cross-linker", fun find_ld/2},
- {"for object extension", fun find_obj/2},
- {"for shared libraries extension", fun find_dll/2},
- {"for executables extension", fun find_exe/2},
- {"for make", fun find_make/2}].
-
-target_architecture({Architecture, _Target_host}, Vars) ->
- case lists:member(Architecture, ?PLATFORMS) of
- true ->
- {Architecture, [{host_os, os_type(Architecture)}, {host, Architecture}|Vars]};
- false ->
- {"unsupported_platform", Vars}
- end.
-
-target_host({_Architecture, Target_host}, Vars) ->
- {Target_host, [{target_host, Target_host} | Vars]}.
-
-cpu({Arch, _Target_host}, Vars) ->
- Cpu = processor(Arch),
- {Cpu, [{host_cpu, Cpu}|Vars]}.
-
-find_gcc({Arch, _Target_host}, Vars) ->
- Gcc = "cc" ++ gnu_suffix(Arch),
- case os:find_executable(Gcc) of
- false ->
- {no, Vars};
- Path when is_list(Path) ->
- Cflags = cflags(Arch),
- {Path, [{'CC', Gcc},
- {'CFLAGS', Cflags},
- {'EI_CFLAGS', Cflags},
- {'ERTS_CFLAGS', Cflags},
- {'DEFS', ""},
- {'ERTS_LIBS', ""},
- {'LIBS', ""},
- {'SHLIB_CFLAGS', Cflags},
- {test_c_compiler, "{gnuc, undefined}"} | Vars]}
- end.
-
-find_ld({Arch, _Target_host}, Vars) ->
- Linker = "ld" ++ gnu_suffix(Arch),
- case os:find_executable(Linker) of
- false ->
- {no, Vars};
- Path when is_list(Path) ->
- {Path, [{'LD', Linker},
- {'CROSSLDFLAGS', ldflags(Arch)},
- {'SHLIB_EXTRACT_ALL', ""},
- {'SHLIB_LD', Linker},
- {'SHLIB_LDFLAGS', ""},
- {'SHLIB_LDLIBS', ""} | Vars]}
- end.
-
-find_obj({Arch, _Target_host}, Vars) ->
- Obj = obj_ext(Arch),
- {Obj, [{obj, Obj}|Vars]}.
-
-find_dll({Arch, _Target_host}, Vars) ->
- Dll = dll_ext(Arch),
- {Dll, [{'SHLIB_SUFFIX', Dll}|Vars]}.
-
-find_exe({Arch, _Target_host}, Vars) ->
- Exe = exe_ext(Arch),
- {Exe, [{exe, Exe}|Vars]}.
-
-find_make(_, Vars) ->
- {"make", [{make_command, "make"} | Vars]}.
-
-%%% some utility functions
-gnu_suffix(Arch) ->
- {_, _, _, _, Suffix, _Cpu, _Cflags, _} = cross_data(Arch),
- Suffix.
-
-processor(Arch) ->
- {_, _, _, _, _Suffix, Cpu, _Cflags, _} = cross_data(Arch),
- Cpu.
-
-cflags(Arch) ->
- {_, _, _, _, _Suffix, _Cpu, Cflags, _} = cross_data(Arch),
- Cflags.
-
-ldflags(Arch) ->
- {_, _, _, _, _Suffix, _Cpu, _Cflags, Ldflags} = cross_data(Arch),
- Ldflags.
-
-os_type(Arch) ->
- {Os_type, _, _, _, _, _, _, _} = cross_data(Arch),
- Os_type.
-
-obj_ext(Arch) ->
- {_, _, Obj, _, _, _, _, _} = cross_data(Arch),
- Obj.
-
-dll_ext(Arch) ->
- {_, _, _, Dll, _, _, _, _} = cross_data(Arch),
- Dll.
-
-exe_ext(Arch) ->
- {_, Exe, _, _, _, _, _, _} = cross_data(Arch),
- Exe.
-
-cross_data(Arch) ->
- case Arch of
- "vxworks_cpu32" ->
- {"VxWorks", "", ".o", ".eld", "68k", "cpu32",
- "-DCPU=CPU32 -DVXWORKS -I$(WIND_BASE)/target/h -mnobitfield -fno-builtin -nostdinc -fvolatile -msoft-float",
- "-r -d"};
- "vxworks_ppc860" ->
- {"VxWorks", "", ".o", ".eld", "ppc", "ppc860",
- "-DCPU=PPC860 -DVXWORKS -I$(WIND_BASE)/target/h -mcpu=860 -fno-builtin -fno-for-scope -msoft-float -D_GNU_TOOL -nostdinc",
- "-r -d"};
- "vxworks_ppc603" ->
- {"VxWorks", "", ".o", ".eld", "ppc", "ppc603",
- "-DCPU=PPC603 -DVXWORKS -I$(WIND_BASE)/target/h -fno-builtin -fno-for-scope -D_GNU_TOOL -nostdinc",
- "-r -d"};
- "vxworks_sparc" ->
- %%% The Sparc Architecture is included for private use (i.e. not Tornado 1.0.1 compatible).
- {"VxWorks", "", ".o", ".eld", "sparc", "sparc",
- "-DCPU=SPARC -DVXWORKS -I/home/gandalf/bsproj/BS.2/UOS/vw/5.2/h -fno-builtin -nostdinc",
- "-r -d"};
- "vxworks_ppc750" ->
- {"VxWorks", "", ".o", ".eld", "ppc", "ppc604",
- "-DCPU=PPC604 -DVXWORKS -DTOOL_FAMILY=gnu -DTOOL=gnu -I$(WIND_BASE)/target/h -fno-builtin -fno-for-scope -D_GNU_TOOL",
- "-r -d"};
- "vxworks_simso" ->
- {"VxWorks", "", ".o", ".eld", "simso", "simso",
- "-DCPU=SIMSPARCSOLARIS -DVXWORKS -DTOOL_FAMILY=gnu -DTOOL=gnu -I$(WIND_BASE)/target/h -I$(WIND_GCC_INCLUDE) -fno-builtin -fno-for-scope -D_GNU_TOOL",
- "-r -d"}
-
- end.
diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl
index 45d88016a4..83f8362735 100644
--- a/lib/test_server/src/ts_erl_config.erl
+++ b/lib/test_server/src/ts_erl_config.erl
@@ -160,7 +160,6 @@ system_include(Root, Vars) ->
SysDir =
case ts_lib:var(os, Vars) of
"Windows" ++ _T -> "sys/win32";
- "VxWorks" -> "sys.vxworks";
_ -> "sys/unix"
end,
" -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))).
@@ -176,9 +175,6 @@ erl_interface(Vars,OsType) ->
{installed, _Root} ->
{filename:join(Dir, "lib"),
filename:join(Dir, "src")};
- {srctree, _Root, _Target} when OsType =:= vxworks ->
- {filename:join(Dir, "lib"),
- filename:join([Dir, "src"])};
{srctree, _Root, Target} ->
{filename:join([Dir, "obj", Target]),
filename:join([Dir, "src", Target])}
@@ -218,7 +214,7 @@ erl_interface(Vars,OsType) ->
{unix,_} ->
"-lpthread";
_ ->
- "" % VxWorks
+ ""
end,
[{erl_interface_libpath, quote(filename:nativename(LibPath))},
{erl_interface_sock_libs, sock_libraries(OsType)},
@@ -318,16 +314,12 @@ get_var(Key, Vars) ->
sock_libraries({win32, _}) ->
"ws2_32.lib";
sock_libraries({unix, _}) ->
- ""; % Included in general libraries if needed.
-sock_libraries(vxworks) ->
- "".
+ "". % Included in general libraries if needed.
link_library(LibName,{win32, _}) ->
LibName ++ ".lib";
link_library(LibName,{unix, _}) ->
"lib" ++ LibName ++ ".a";
-link_library(LibName,vxworks) ->
- "lib" ++ LibName ++ ".a";
link_library(_LibName,_Other) ->
exit({link_library, not_supported}).
diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl
index 99ccfbc9bc..8edb1ed5c6 100644
--- a/lib/test_server/src/ts_install.erl
+++ b/lib/test_server/src/ts_install.erl
@@ -55,8 +55,7 @@ build_install(TargetSystem, Options) ->
end.
os_type({unix,_}=OsType) -> OsType;
-os_type({win32,_}=OsType) -> OsType;
-os_type(_Other) -> vxworks.
+os_type({win32,_}=OsType) -> OsType.
target_install(CrossVars) ->
io:format("Cross installation detected, skipping configure and data_dir make~n"),
@@ -76,7 +75,6 @@ target_install(CrossVars) ->
%% Autoconf for various platforms.
%% unix uses the configure script
%% win32 uses ts_autoconf_win32
-%% VxWorks uses ts_autoconf_vxworks.
autoconf(TargetSystem, XComp) ->
case autoconf1(TargetSystem, XComp) of
@@ -90,8 +88,6 @@ autoconf1({win32, _},[{cross,"no"}]) ->
ts_autoconf_win32:configure();
autoconf1({unix, _},XCompFile) ->
unix_autoconf(XCompFile);
-autoconf1(Other,[{cross,"no"}]) ->
- ts_autoconf_vxworks:configure(Other);
autoconf1(_,_) ->
io:format("cross compilation not supported for that this platform~n"),
throw(cross_installation_failed).
diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl
index a61028e4bc..5ce8e66660 100644
--- a/lib/test_server/src/ts_run.erl
+++ b/lib/test_server/src/ts_run.erl
@@ -157,7 +157,6 @@ get_config_files() ->
[TSConfig | case os:type() of
{unix,_} -> ["ts.unix.config"];
{win32,_} -> ["ts.win32.config"];
- vxworks -> ["ts.vxworks.config"];
_ -> []
end].
@@ -329,8 +328,7 @@ start_xterm(Command) ->
path_separator() ->
case os:type() of
{win32, _} -> ";";
- {unix, _} -> ":";
- vxworks -> ":"
+ {unix, _} -> ":"
end.
diff --git a/lib/test_server/src/vxworks_client.erl b/lib/test_server/src/vxworks_client.erl
deleted file mode 100644
index ca65eca02a..0000000000
--- a/lib/test_server/src/vxworks_client.erl
+++ /dev/null
@@ -1,243 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-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(vxworks_client).
-
--export([open/1, close/1, send_data/2, send_data/3, send_data_wait_for_close/2, reboot/1]).
--export([init/2]).
-
--include("ts.hrl").
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% This is a client talking to a test server daemon on a VxWorks card.
-%%%
-%%% User interface:
-%%%
-%%% open/1
-%%% Start a client and establish the connection with the test server daemon
-%%%
-%%% send_data/2
-%%% Send data/command to the test server daemon, don't wait for any return
-%%%
-%%% send_data/3
-%%% Send data/command to the test server daemon and wait for the given
-%%% return value.
-%%%
-%%% send_data_wait_for_close/2
-%%% Send data/command to the test server daemon and wait for the daemon to
-%%% close the connection.
-%%%
-%%% close/1
-%%% Close the client.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-%%
-%% User interface
-%%
-
-reboot(Target) ->
- {ok, {_,_,_,_,_,[Addr|_]}} = inet:gethostbyname(Target),
- Fun = fun({ok, Socket}) ->
- gen_tcp:send(Socket, "q\n"),
- receive
- {tcp_closed, Socket} ->
- gen_tcp:close(Socket),
- {ok, socket_closed}
- after 5000 ->
- exit({timeout, tryagain})
- end
- end,
- io:format("Stopping (rebooting) ~p ",[Target]),
- case fun_target(Addr, Fun) of
- {ok, socket_closed} ->
- ok;
- _Else ->
- io:format("No contact with ts daemon - exiting ...~n"),
- exit({stop, no_ts_daemon_contact})
- end.
-
-
-%% open(Target) -> {ok,Client} | {error, Reason}
-open(Target) ->
- {ok, {_,_,_,_,_,[Addr|_]}} = inet:gethostbyname(Target),
- Fun = fun({ok, Socket}) ->
- P = spawn(?MODULE,init,[Target,Socket]),
- inet_tcp:controlling_process(Socket,P),
- {ok,P}
- end,
- case fun_target(Addr,Fun) of
- {ok, Pid} ->
- {ok, Pid};
- {error,Reason} ->
- {error, Reason}
- end.
-
-%% send_data(Client,Data) -> ok
-send_data(Pid,Data) ->
- Pid ! {send_data,Data++"\n"},
- ok.
-
-%% send_data(Client,Data,ExpectedReturn) -> {ok,ExpectedReturn} | {error,Reason}
-send_data(Pid,Data,Return) ->
- Pid ! {send_data,Data++"\n",Return,self()},
- receive {Pid,Result} -> Result end.
-
-%% send_data_wait_for_close(Client,Data) -> ok | {error,Reason}
-send_data_wait_for_close(Pid,Data) ->
- send_data(Pid,Data,tcp_closed).
-
-%% close(Client) -> ok
-close(Pid) ->
- Pid ! close,
- ok.
-
-
-%%
-%% Internal
-%%
-
-init(Target,Socket) ->
- process_flag(trap_exit,true),
- loop(Target,Socket).
-
-loop(Target,Socket) ->
- receive
- {send_data,Data} ->
- %% io:format("vx client sending: ~p~n", [Data]),
- gen_tcp:send(Socket, Data),
- loop(Socket,Target);
- {send_data,Data,tcp_closed,From} ->
- %% io:format("vx client sending: ~p~n", [Data]),
- gen_tcp:send(Socket, Data),
- receive
- {tcp_closed, Socket} ->
- From ! {self(),ok}
- after 5000 ->
- From ! {self(),{error,timeout}}
- end,
- closed(Socket,normal);
- {send_data,Data,Return,From} ->
- %% io:format("vx client sending: ~p~n", [Data]),
- gen_tcp:send(Socket, Data),
- case receive_line(Socket,[],Return,200) of
- {tcp_closed, Socket} ->
- From ! {self(),{error,{socket_closed,Target}}},
- closed(Socket,{socket_closed,Target});
- {tcp,Socket,_Rest} ->
- From ! {self(),{ok,Data}},
- got_data(Target,Socket,Data);
- error ->
- From ! {self(),{error,{catatonic,Target}}}
- end;
- close ->
- closed(Socket,normal);
- {tcp_closed, Socket} ->
- closed(Socket,{socket_closed,Target});
- {tcp,Socket,Data} ->
- got_data(Target,Socket,Data)
- end.
-
-
-
-closed(Socket,Reason) ->
- gen_tcp:close(Socket),
- exit(Reason).
-
-got_data(Target,Socket,Data) ->
- if is_atom(Target) ->
- io:format("~w: ~s",[Target,uncr(Data)]);
- true ->
- io:format("~s: ~s",[Target,uncr(Data)])
- end,
- loop(Target,Socket).
-
-uncr([]) ->
- [];
-uncr([$\r | T]) ->
- uncr(T);
-uncr([H | T]) ->
- [H | uncr(T)].
-
-strip_line(Line) ->
- RPos = string:rchr(Line, $\n),
- string:substr(Line,RPos+1).
-
-maybe_done_receive(Socket,Ack,Match,C) ->
- case string:str(Ack,Match) of
- 0 ->
- receive_line(Socket,strip_line(Ack),Match,C);
- _ ->
- {tcp,Socket,strip_line(Ack)}
- end.
-
-
-receive_line(_Socket,_Ack,_Match,0) ->
- error;
-receive_line(Socket,Ack,Match,Counter) ->
- receive
- {tcp_closed, Socket} ->
- {tcp_closed, Socket};
- {tcp,Socket,Data} ->
- NewAck = Ack ++ Data,
- case {string:str(NewAck,"\r") > 0,
- string:str(NewAck,"\n") > 0} of
- {true,_} ->
- maybe_done_receive(Socket,NewAck,Match,Counter-1);
- {_,true} ->
- maybe_done_receive(Socket,NewAck,Match,Counter-1);
- _ ->
- receive_line(Socket,NewAck,Match,Counter)
- end
- after 20000 ->
- error
- end.
-
-
-%% Misc functions
-fun_target(Addr, Fun) ->
- io:format("["),
- fun_target(Addr, Fun, 60). %Vx-cards need plenty of time.
-
-fun_target(_Addr, _Fun, 0) ->
- io:format(" no contact with ts daemon]~n"),
- {error,failed_to_connect};
-fun_target(Addr, Fun, Tries_left) ->
- receive after 1 -> ok end,
- case do_connect(Addr, Fun) of
- {ok, Value} ->
- io:format(" ok]~n"),
- {ok, Value};
- _Error -> % typical {error, econnrefused}
- io:format("."),
- receive after 10000 -> ok end,
- fun_target(Addr, Fun, Tries_left-1)
- end.
-
-do_connect(Addr, Fun) ->
- case gen_tcp:connect(Addr, ?TS_PORT, [{reuseaddr, true}], 60000) of
- {ok, Socket} ->
- Fun({ok, Socket});
- Error ->
- Error
- end.
-
-
-