diff options
author | Björn-Egil Dahlberg <egil@erlang.org> | 2012-07-17 19:15:09 +0200 |
---|---|---|
committer | Björn-Egil Dahlberg <egil@erlang.org> | 2012-07-19 20:22:54 +0200 |
commit | 1fc645451d1d32db120fae5bcefd4c6653ca4f41 (patch) | |
tree | de8bfe64d3229dd92f1d9378bc5e40d1234d2f5b /lib/test_server/src | |
parent | c6266995b9e007af4b48db8de1ddbaa7ced912fe (diff) | |
download | otp-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/Makefile | 4 | ||||
-rw-r--r-- | lib/test_server/src/test_server.erl | 6 | ||||
-rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 8 | ||||
-rw-r--r-- | lib/test_server/src/test_server_internal.hrl | 2 | ||||
-rw-r--r-- | lib/test_server/src/test_server_node.erl | 43 | ||||
-rw-r--r-- | lib/test_server/src/ts.erl | 7 | ||||
-rw-r--r-- | lib/test_server/src/ts_autoconf_vxworks.erl | 191 | ||||
-rw-r--r-- | lib/test_server/src/ts_erl_config.erl | 12 | ||||
-rw-r--r-- | lib/test_server/src/ts_install.erl | 6 | ||||
-rw-r--r-- | lib/test_server/src/ts_run.erl | 4 | ||||
-rw-r--r-- | lib/test_server/src/vxworks_client.erl | 243 |
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. - - - |