aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_port_handler.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gs/src/gstk_port_handler.erl')
-rw-r--r--lib/gs/src/gstk_port_handler.erl465
1 files changed, 465 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_port_handler.erl b/lib/gs/src/gstk_port_handler.erl
new file mode 100644
index 0000000000..93f3e58dc2
--- /dev/null
+++ b/lib/gs/src/gstk_port_handler.erl
@@ -0,0 +1,465 @@
+%%
+%% %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).
+
+-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}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 06:18:59 +0000