%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-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%
%%
%%
%% ------------------------------------------------------------
%%
%% This is a driver for the 'gstk' application modified to
%% handle events for gs. 'gstk' is a modified standalone wish.
%%
%% FIXME
%% mkdir tcl ; cd tcl
%% ( cd /usr/local/pgm/tcl-8.3.3 ; tar -cf - * ) | tar -xf -
%% ( cd /usr/local/pgm/tk-8.3.3 ; tar -cf - * ) | tar -xf -
%% rm -fr include man bin/tclsh
%% cd ..
%% tar -cf tcl.tar *
%%
%% ------------------------------------------------------------
-module(gstk_port_handler).
-compile([{nowarn_deprecated_function,{gs,error,2}}]).
-include("gstk.hrl").
% The executable can have many names. There is not always
% a plain "wish" program.
% FIXME There has to be a better solution....
% FIXME Add option in app file or environmen variable.
-define(WISHNAMES, ["wish85","wish8.5",
"wish84","wish8.4",
"wish83","wish8.3",
"wish82","wish8.2",
"wish"]).
%% ------------------------------------------------------------
%% DEBUG FUNCTIONS
%% ------------------------------------------------------------
-export([exec/1,call/2,
start_link/1,init/2,ping/1,stop/1]).
-export([wait_for_connection/2]).
-define(START_TIMEOUT , 1000 * 30).
-define(ACCEPT_TIMEOUT, 1000 * 20).
-define(DEBUGLEVEL, 4).
-ifdef(DEBUG).
-define(DBG(DbgLvl,Format, Data),dbg(DbgLvl, Format, Data)).
-define(DBG_STR(DbgLvl, What, Str),dbg_str(DbgLvl, What, Str)).
dbg(DbgLvl, Format, Data) when DbgLvl =< ?DEBUGLEVEL ->
ok = io:format("DBG: " ++ Format, Data);
dbg(_DbgLvl, _Format, _Data) -> ok.
dbg_str(DbgLvl, What, Str) when DbgLvl =< ?DEBUGLEVEL ->
ok = io:format("DBG: ~s~s\n", [What,dbg_s(Str)]);
dbg_str(_DbgLvl, _What, _Data) -> ok.
dbg_s([]) ->
[];
dbg_s([C | Str]) when list(C) ->
[dbg_s(C) | dbg_s(Str)];
dbg_s([C | Str]) when C >= 20, C < 255 ->
[C | dbg_s(Str)];
dbg_s([$\n | Str]) ->
["\\n" | dbg_s(Str)];
dbg_s([$\r | Str]) ->
["\\r" | dbg_s(Str)];
dbg_s([$\t | Str]) ->
["\\t" | dbg_s(Str)];
dbg_s([C | Str]) when integer(C) ->
[io_lib:format("\\~.3.0w",[C]) | dbg_s(Str)].
-else.
-define(DBG(DbgLvl,Format, Data), true).
-define(DBG_STR(DbgLvl, What, Str), true).
-endif.
%% ------------------------------------------------------------
%% INTERFACE FUNCTIONS
%% ------------------------------------------------------------
% Note: gs is not a true application so this doesn't work :-(
% Communication protocol between Erlang backend and wish program
% that can be set in the application environment, e.i. tested
% with "erl -gs backend_comm socket"
%
% backend_comm = socket | port
%
% We fake reading the application variables from the command line.
% Note that multiple -gs arguments can't be used.
get_env(App, KeyAtom) ->
KeyStr = atom_to_list(KeyAtom),
?DBG(1,"Result from init:get_argument(~w): ~p\n",
[KeyAtom,init:get_argument(App)]),
case init:get_argument(App) of
{ok,[[KeyStr,ValStr]]} ->
{ok,list_to_atom(ValStr)};
_ ->
undefined
end.
start_link(Gstk) ->
?DBG(1, "start_link(~w)~n", [Gstk]),
% io:format("STARTS ~p\n",[erlang:localtime()]),
Mode =
% FIXME: Want to use application:get_env() if we where an true app
case {os:type(),get_env(gs,backend_comm)} of
{{win32,_Flavor},undefined} ->
use_socket;
{_OS,undefined} ->
use_port;
{_OS,{ok,socket}} ->
use_socket;
{_OS,{ok,port}} ->
use_port
end,
?DBG(1,"We use mode: ~w (~w)\n",[Mode,get_env(gs,backend_comm)]),
Pid = spawn_link(gstk_port_handler, init, [Gstk,Mode]),
receive
{Pid, ok} ->
{ok, Pid};
{Pid, error, Reason} ->
{error, Reason}
after ?START_TIMEOUT ->
{error, timeout}
end.
call(PortHandler, Cmd) ->
PortHandler ! {call, ["erlcall {",Cmd,$}]},
receive
{result, Result} ->
?DBG(1, "call reply: ~p~n", [Result]),
{result, Result};
{bad_result, Bad_Result} ->
?DBG(1, "bad call reply: ~p~n", [Bad_Result]),
{bad_result, Bad_Result}
end.
ping(PortHandler) ->
?DBG(1, "ping~n", []),
PortHandler ! {ping, self()},
receive
{pong,_From,PortOrSock} -> {ok,PortOrSock}
end.
stop(PortHandler) ->
?DBG(1, "stop~n", []),
PortHandler ! {stop,self()},
receive
{stopped,PortHandler} -> ok
end.
%% Purpose: asyncron call to tk
%% too expensive
% FIXME
exec(Cmd) ->
get(port_handler) ! {exec, ["erlexec {",Cmd,$}]},
ok.
% in gstk context, but I don't want "ifndef nt40" in other
% modules than this one.
%exec(Cmd) ->
% ?DBG_STR(1, "", ["erlexec {",Cmd,"}"]),
% case get(port) of
% {socket,Sock} ->
% gen_tcp:send(Sock, ["erlexec {",Cmd,$}]);
% {port,Port} ->
% Port ! {get(port_handler),{command,["erlexec {",Cmd,$}]}}
% end,
% ok.
%% ===========================================================================
%% The server
%% ===========================================================================
%% ---------------------------------------------------------------------
%% We initiate by starting the wish port program and use the pipe
%% or a socket to communicate with it.
%%
%% gstk: is the pid of the gstk process that started me.
%% all my input (from the port) is forwarded to it.
%%----------------------------------------------------------------------
-record(state,{out,gstk}).
init(Gstk, Mode) ->
process_flag(trap_exit,true),
% ------------------------------------------------------------
% Set up paths
% ------------------------------------------------------------
PrivDir = code:priv_dir(gs),
TclDir = filename:join(PrivDir,"tcl"),
TclBinDir = filename:join(TclDir,"bin"),
TclLibDir = filename:join(TclDir,"lib"),
InitScript = filename:nativename(filename:join(PrivDir,"gstk.tcl")),
?DBG(1, "TclBinDir : ~s\n", [TclBinDir]),
?DBG(1, "TclLibDir : ~s\n", [TclLibDir]),
?DBG(1, "InitScript : ~s\n", [InitScript]),
% ------------------------------------------------------------
% Search for wish in priv and in system search path
% ------------------------------------------------------------
{Wish,Options} =
case filelib:wildcard(filename:join(TclBinDir,"wish*")) of
% If more than one wish in priv we assume they are the same
[PrivWish | _] ->
% ------------------------------------------------
% We have to set TCL_LIBRARY and TK_LIBRARY because else
% 'wish' will search in the original installation directory
% for 'tclIndex' and this may be an incompatible version on
% the host we run on.
% ------------------------------------------------
[TclLibrary] =
filelib:wildcard(filename:join(PrivDir,
"tcl/lib/tcl[1-9]*")),
[TkLibrary] =
filelib:wildcard(filename:join(PrivDir,
"tcl/lib/tk[1-9]*")),
Opts = [{env,[{"TCL_LIBRARY", TclLibrary},
{"TK_LIBRARY", TkLibrary},
{"LD_LIBRARY_PATH",TclLibDir}]},
{packet,4}],
{PrivWish,Opts};
_ ->
% We use the system wish program
{search_wish(?WISHNAMES, Gstk),[{packet,4}]}
end,
?DBG(1, "Wish : ~s\n", [Wish]),
Cmd =
case Mode of
use_socket ->
% ------------------------------------------------------------
% Set up a listening socket and call accept in another process
% ------------------------------------------------------------
SocketOpts =
[
{nodelay, true},
{packet,4},
{reuseaddr,true}
],
% Let OS pick a number
{ok,ListenSocket} = gen_tcp:listen(0, SocketOpts),
{ok,ListenPort} = inet:port(ListenSocket),
% Wait in another process
spawn_link(?MODULE,wait_for_connection,[self(),ListenSocket]),
lists:concat([Wish," ",InitScript," -- ",PrivDir," ",
ListenPort]);
use_port ->
lists:concat([Wish," ",InitScript," -- ",PrivDir])
end,
?DBG(1, "Port opts :\n~p\n", [Options]),
% FIXME remove timing if not debugging
Port =
case timer:tc(erlang,open_port,[{spawn, Cmd}, Options]) of
{_T,Port1} when is_port(Port1) ->
?DBG(1,"open_port takes ~p milliseconds\n",[_T/1000]),
link(Port1),
Port1;
{_T,{error,_Reason1}} -> % FIXME: Why throw away reason?!
?DBG(1,"ERROR: ~p\n",[_Reason1]),
Gstk ! {self(), error, backend_died},
exit(normal)
end,
State =
case Mode of
use_socket ->
% ------------------------------------------------------------
% Wait for a connection
% ------------------------------------------------------------
Sock =
receive
{connected,Socket} ->
Socket;
% FIXME: Why throw away reason?!
{'EXIT', _Pid, _Reason2} ->
Gstk ! {self(), error, backend_died},
exit(normal)
end,
?DBG(1,"Got socket ~p~n",[Sock]),
#state{out={socket,Sock}, gstk=Gstk};
use_port ->
#state{out={port,Port}, gstk=Gstk}
end,
Gstk ! {self(), ok}, % Tell caller we are prepared
idle(State).
search_wish([], Gstk) ->
Gstk ! {self(), error, backend_died},
exit(normal);
search_wish([WishName | WishNames], Gstk) ->
case os:find_executable(WishName) of
false ->
search_wish(WishNames, Gstk);
Wish ->
Wish
end.
%%----------------------------------------------------------------------
%% If we use sockets we wait for connection from port prog
%%----------------------------------------------------------------------
wait_for_connection(CallerPid, ListenSocket) ->
{ok,Sock} = gen_tcp:accept(ListenSocket, ?ACCEPT_TIMEOUT),
?DBG(1,"Got accept ~p~p~n",[self(),Sock]),
ok = gen_tcp:controlling_process(Sock,CallerPid),
CallerPid ! {connected,Sock}.
%% ===========================================================================
%% The main loop
%% ===========================================================================
idle(State) ->
?DBG(1, "idle~n", []),
% io:format("IDLE ~p\n",[erlang:localtime()]),
receive
{call, Cmd} ->
output(State, Cmd),
idle(State);
{exec, Cmd} ->
collect_exec_calls(Cmd, [], 0, State),
idle(State);
{_Port, {data, Input}} ->
?DBG_STR(2, "INPUT[port]: ", [Input]),
handle_input(State, Input),
idle(State);
{tcp, _Sock, Input} ->
?DBG_STR(2, "INPUT[sock]: ", [Input]),
handle_input(State, Input),
idle(State);
{ping,From} ->
From ! {pong,self(),State#state.out},
idle(State);
{stop,From} ->
From ! {stopped,self()};
% FIXME: We are we not to terminate if watforsocket
% terminated but what about the port???????
{'EXIT',_Pid,normal} ->
?DBG(1, "EXIT[~w]: normal~n", [_Pid]),
idle(State);
{'EXIT',Pid,Reason} ->
%%io:format("Port died when in idle loop!~n"),
?DBG(1,"EXIT[~w]~n~p~n",[Pid,Reason]),
exit({port_handler,Pid,Reason});
Other ->
?DBG(1,"OTHER: ~p~n",[Other]),
gs:error("gstk_port_handler: got other: ~w~n",[Other]),
idle(State)
end.
%% ----------------------------------------------------------------------
-define(MAXQUEUE, 4). % FIXME find value...
collect_exec_calls(Cmd, Queue, QueueLen, State) when QueueLen < ?MAXQUEUE ->
receive
{exec, NewCmd} ->
% io:format("collect~p~n", [NewCmd]),
collect_exec_calls(NewCmd, [Cmd | Queue], QueueLen+1, State)
after 0 ->
if
QueueLen == 0 ->
output(State, Cmd);
true ->
output(State, join_cmd_reverse(Cmd, Queue, []))
end
end;
collect_exec_calls(Cmd, Queue, _QueueLen, State) -> % Queue is full, output
String = join_cmd_reverse(Cmd, Queue, []),
% io:format("queue full: ~p~n", [String]),
output(State, String).
join_cmd_reverse(Cmd, [], DeepStr) ->
[DeepStr | Cmd];
join_cmd_reverse(Cmd, [Cmd1 | Cmds], DeepStr) ->
join_cmd_reverse(Cmd, Cmds, [Cmd1,$; | DeepStr]).
%% ----------------------------------------------------------------------
%%
%% Handle incoming data
%% 1 - Event
%% 2 - Reply from call
%% 3 - Bad reply from call
%% 4 - Error
%% 5 - End of message
%%
handle_input(State,[Type | Data]) ->
GstkPid = State#state.gstk,
case Type of
1 ->
handle_event(GstkPid,Data);
2 ->
GstkPid ! {result, Data};
3 ->
GstkPid ! {bad_result, Data};
4 ->
gs:error("gstk_port_handler: error in input : ~s~n",[Data])
end.
%% ----------------------------------------------------------------------
%% output a command to the port
%% buffer several incoming execs
%%
output(#state{out = {socket,Sock}}, Cmd) ->
?DBG_STR(1, "OUTPUT[sock]: ", [Cmd]),
ok = gen_tcp:send(Sock, Cmd);
output(#state{out = {port,Port}}, Cmd) ->
?DBG_STR(1, "OUTPUT[port]: ", [Cmd]),
Port ! {self(), {command, Cmd}}.
% FIXME why test list?
handle_event(GstkPid, Bytes) when is_list(Bytes) ->
Event = tcl2erl:parse_event(Bytes),
?DBG(1,"Event = ~p\n",[Event]),
gstk:event(GstkPid, Event). %% Event is {ID, Etag, Args}
