aboutsummaryrefslogtreecommitdiffstats
path: root/lib/sasl/src/erlsrv.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/sasl/src/erlsrv.erl')
-rw-r--r--lib/sasl/src/erlsrv.erl420
1 files changed, 420 insertions, 0 deletions
diff --git a/lib/sasl/src/erlsrv.erl b/lib/sasl/src/erlsrv.erl
new file mode 100644
index 0000000000..f9804c41dc
--- /dev/null
+++ b/lib/sasl/src/erlsrv.erl
@@ -0,0 +1,420 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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(erlsrv).
+
+%% Purpose : Control the external erlsrv program.
+
+%%-compile(export_all).
+-export([get_all_services/0,get_service/1,get_service/2,store_service/1,
+ store_service/2,
+ new_service/3, new_service/4, disable_service/2,
+ enable_service/2, disable_service/1, enable_service/1,
+ remove_service/1, erlsrv/1, rename_service/2,
+ rename_service/3]).
+
+erlsrv(EVer) ->
+ Root = code:root_dir(),
+ filename:join([Root, "erts-" ++ EVer, "bin", "erlsrv.exe"]).
+
+current_version() ->
+ hd(string:tokens(erlang:system_info(version),"_ ")).
+
+%%% Returns {ok, Output} | failed | {error, Reason}
+run_erlsrv(Command) ->
+ run_erlsrv(current_version(),Command).
+run_erlsrv(EVer, Command) ->
+ case catch(open_port({spawn, erlsrv(EVer) ++ " " ++ Command},
+ [{line,1000}, in, eof])) of
+ {'EXIT',{Reason,_}} ->
+ {port_error, Reason};
+ Port ->
+ case read_all_data(Port) of
+ [] ->
+ failed;
+ X ->
+ {ok, X}
+ end
+ end.
+
+run_erlsrv_interactive(EVer, Commands) ->
+ case catch(open_port({spawn, erlsrv(EVer) ++ " readargs"},
+ [{line,1000}, eof])) of
+ {'EXIT',{Reason,_}} ->
+ {port_error, Reason};
+ Port ->
+ write_all_data(Port, Commands),
+ case read_all_data(Port) of
+ [] ->
+ failed;
+ X ->
+ {ok, X}
+ end
+ end.
+
+write_all_data(Port,[]) ->
+ Port ! {self(), {command, io_lib:nl()}},
+ ok;
+write_all_data(Port,[H|T]) ->
+ Port ! {self(), {command, H ++ io_lib:nl()}},
+ write_all_data(Port,T).
+
+read_all_data(Port) ->
+ receive
+ {Port, {data, {eol,Data}}} ->
+ [ Data | read_all_data(Port)];
+ _ ->
+ Port ! {self(), close},
+ receive
+ {Port, closed} ->
+ []
+ end
+ end.
+
+
+%%% Get all registered erlsrv services.
+get_all_services() ->
+ case run_erlsrv("list") of
+ failed ->
+ [];
+ {ok, [_]} ->
+ [];
+ {ok, [_H|T]} ->
+ F = fun(X) ->
+ hd(string:tokens(X,"\t "))
+ end,
+ lists:map(F,T);
+ _ ->
+ {error, external_program_failed}
+ end.
+
+disable_service(ServiceName) ->
+ disable_service(current_version(), ServiceName).
+disable_service(EVer, ServiceName) ->
+ run_erlsrv(EVer, "disable " ++ ServiceName).
+enable_service(ServiceName) ->
+ enable_service(current_version(), ServiceName).
+enable_service(EVer, ServiceName) ->
+ run_erlsrv(EVer, "enable " ++ ServiceName).
+remove_service(ServiceName) ->
+ run_erlsrv("remove " ++ ServiceName).
+rename_service(FromName, ToName) ->
+ rename_service(current_version(), FromName, ToName).
+rename_service(EVer, FromName, ToName) ->
+ run_erlsrv(EVer, "rename " ++ FromName ++ " " ++ ToName).
+
+%%% Get all information about a service
+%%% Returns [{Field,Value | []} ...]
+%%% Field is one of:
+%%% servicename : The service name (equal to parameter...)
+%%% stopaction : The erlang expression that shall stop the node
+%%% onfail : Action to take when erlang fails unexpectedly
+%%% machine : Full pathname of the erlang machine or start_erl program
+%%% workdir : The initial working directory of the erlang machine
+%%% sname | name : The short name of the node
+%%% priority : The OS priority of the erlang process
+%%% args : All arguments correctly parsed into a list of strings
+%%% comment : The service description
+%%% internalservicename : The windows internal service name
+%%% env : A list of environment variables and values [{"VAR", "VALUE"}]
+%%% Example:
+%%% [{servicename,"kalle_R4A"},
+%%% {stopaction,"erlang:halt()."},
+%%% {args,["-boot", "nisse","--","-reldir", "c:\myapproot"]}
+%%% {env,[{"FOO","BAR"},{"VEGETABLE","TOMATO"}]}]
+
+get_service(ServiceName) ->
+ get_service(current_version(), ServiceName).
+get_service(EVer, ServiceName) ->
+ case run_erlsrv(EVer, "list " ++ ServiceName) of
+ failed ->
+ {error, no_such_service};
+ {port_error, Reason} ->
+ {error, {port_error, Reason}};
+ {ok, Data} ->
+ Table = [{"Service name",servicename,[]},
+ {"StopAction",stopaction, []},
+ {"OnFail",onfail, "ignore"},
+ {"Machine",machine, []},
+ {"WorkDir",workdir, []},
+ {"SName",sname, []},
+ {"Name",name, []},
+ {"Priority",priority, "default"},
+ {"DebugType",debugtype, "none"},
+ {"Args",args,[]},
+ {"InternalServiceName",internalservicename,[]},
+ {"Comment",comment,[]}],
+ %% Env has special treatment...
+ F = fun(X) ->
+ {Name,Value} = splitline(X),
+ case lists:keysearch(Name,1,Table) of
+ {value,{Name,_Atom,Value}} ->
+ [];
+ {value,{Name,Atom,_}} ->
+ {Atom,Value};
+ _ ->
+ []
+ end
+ end,
+ %%% First split by Env:
+ {Before, After} = split_by_env(Data),
+ FirstPass = lists:flatten(lists:map(F,Before)),
+ %%% If the arguments are there, split them to
+ SecondPass = split_arglist(FirstPass),
+ %%% And now, if After contains anything, that is vwat to
+ %%% have in the environment list...
+ EnvParts = lists:map(
+ fun(S) ->
+ X = string:strip(S,left,$\t),
+ case hd(string:tokens(X,"=")) of
+ X ->
+ %% Can this happen?
+ {X,""};
+ Y ->
+ {Y,
+ lists:sublist(X,length(Y)+2,
+ length(X))}
+ end
+ end,
+ After),
+ case EnvParts of
+ [] ->
+ SecondPass;
+ _ ->
+ lists:append(SecondPass,[{env,EnvParts}])
+ end
+ end.
+
+
+store_service(Service) ->
+ store_service(current_version(),Service).
+store_service(EmulatorVersion,Service) ->
+ case lists:keysearch(servicename,1,Service) of
+ false ->
+ {error, no_servicename};
+ {value, {_,Name}} ->
+ {Action,Service1} = case get_service(Name) of
+ {error, no_such_service} ->
+ {"add",Service};
+ _ ->
+ {"set",
+ lists:keydelete(internalservicename,1,Service)}
+ end,
+ Commands = [Action | build_commands(Name, Service1)],
+ case run_erlsrv_interactive(EmulatorVersion,Commands) of
+ {ok, _} ->
+ ok;
+ X ->
+ {error, X}
+ end;
+ _ ->
+ {error, malformed_description}
+ end.
+
+build_commands(Action, Service) ->
+ [ Action | lists:reverse(build_commands2(Service,[]))].
+
+build_commands2([],A) ->
+ A;
+build_commands2([{env,[]}|T],A) ->
+ build_commands2(T,A);
+build_commands2([{env,[{Var,Val}|Et]}|T],A) ->
+ build_commands2([{env,Et}|T],[Var ++ "=" ++ Val, "-env" | A]);
+build_commands2([{servicename,_}|T],A) ->
+ build_commands2(T,A);
+build_commands2([{Atom,[]} | T],A) ->
+ build_commands2(T,["-" ++ atom_to_list(Atom) | A]);
+build_commands2([{args,L}|T],A) ->
+ build_commands2(T,[concat_args(L),"-args"| A]);
+build_commands2([{Atom,Value} | T],A) ->
+ build_commands2(T,[Value, "-" ++ atom_to_list(Atom) | A]).
+
+concat_args([H|T]) ->
+ H ++ concat_args2(T).
+concat_args2([]) ->
+ "";
+concat_args2([H|T]) ->
+ " " ++ H ++ concat_args2(T).
+
+
+new_service(NewServiceName, OldService, Data) ->
+ new_service(NewServiceName, OldService, Data, []).
+new_service(NewServiceName, OldService, Data, RestartName) ->
+ Tmp0 = lists:keydelete(internalservicename,1,OldService), %Remove when
+ % creating new service from
+ % old.
+ Tmp1 = lists:keyreplace(servicename, 1, Tmp0,
+ {servicename, NewServiceName}),
+ Tmp = case lists:keysearch(env,1,Tmp1) of
+ {value, {env,Env0}} ->
+ Env1 = lists:keydelete("ERLSRV_SERVICE_NAME",1,Env0),
+ lists:keyreplace(env,1,Tmp1,
+ {env, [{"ERLSRV_SERVICE_NAME",
+ RestartName} |
+ Env1]});
+ _ ->
+ Tmp1
+ end,
+
+ ArgsTmp = case lists:keysearch(args, 1, Tmp) of
+ false ->
+ [];
+ {value, {args, OldArgs}} ->
+ OldArgs
+ end,
+ Args = backstrip(ArgsTmp,"++"), %% Remove trailing ++, has no meaning
+ {Found, Tail} = lists:foldr(fun(A,{Flag,AccIn}) ->
+ case {Flag, A} of
+ {true, _} -> {Flag,AccIn};
+ {false, "++"} -> {true, AccIn};
+ _ -> {false, [A|AccIn]}
+ end
+ end, {false,[]}, Args),
+
+ {OtherFlags, _DataDir} = case Found of
+ true ->
+ check_tail(Tail);
+ false ->
+ {[], false}
+ end,
+ NewArgs1 = case Data of
+ [] ->
+ OtherFlags;
+ _ ->
+ ["-data", Data| OtherFlags]
+ end,
+ case Found of
+ false ->
+ A = case NewArgs1 of
+ [] ->
+ [];
+ _ ->
+ ["++" | NewArgs1]
+ end,
+ case {Args,A} of
+ {[],[]} ->
+ Tmp;
+ {[],_} ->
+ Tmp ++ [{args, A}];
+ {_,_} ->
+ lists:keyreplace(args, 1, Tmp, {args, Args ++ A})
+ end;
+ true ->
+ StripArgs = backstrip(Args,["++"|Tail]),
+ NewArgs2 = case NewArgs1 of
+ [] ->
+ [];
+ _ ->
+ ["++" |NewArgs1]
+ end,
+ NewArgs = StripArgs ++ NewArgs2,
+ lists:keyreplace(args, 1, Tmp, {args, NewArgs})
+ end.
+
+
+backstrip(List,Tail) ->
+ lists:reverse(backstrip2(lists:reverse(List),lists:reverse(Tail))).
+backstrip2([A|T1],[A|T2]) ->
+ backstrip2(T1,T2);
+backstrip2(L,_) ->
+ L.
+
+check_tail(Tail) ->
+ {A,B} = check_tail(Tail, [], false),
+ {lists:reverse(A),B}.
+
+check_tail([], OtherFlags, DataDir) ->
+ {OtherFlags, DataDir};
+check_tail(["-data", TheDataDir|T], OtherFlags, _DataDir) ->
+ check_tail(T, OtherFlags, TheDataDir);
+check_tail([H|T],OtherFlags,DataDir) ->
+ check_tail(T,[H|OtherFlags],DataDir).
+
+
+
+
+%%% Recursive, The list is small
+split_arglist([]) ->
+ [];
+split_arglist([{args,Str}|T]) ->
+ [{args,parse_arglist(Str)}|T];
+split_arglist([H|T]) ->
+ [H|split_arglist(T)].
+
+%% Not recursive, may be long...
+parse_arglist(Str) ->
+ lists:reverse(parse_arglist(Str,[])).
+parse_arglist(Str,Accum) ->
+ Stripped = string:strip(Str,left),
+ case length(Stripped) of
+ 0 ->
+ Accum;
+ _ ->
+ {Next, Rest} = pick_argument(Str),
+ parse_arglist(Rest,[Next | Accum])
+ end.
+
+pick_argument(Str) ->
+ {Rev,Rest} = pick_argument(normal,Str,[]),
+ {lists:reverse(Rev),Rest}.
+
+pick_argument(_,[],Acc) ->
+ {Acc, ""};
+pick_argument(normal,[$ |T],Acc) ->
+ {Acc,T};
+pick_argument(normal,[$"|T],Acc) ->
+ pick_argument(quoted,T,[$"|Acc]);
+pick_argument(quoted_escaped,[H|T],Acc) ->
+ pick_argument(quoted,T,[H|Acc]);
+pick_argument(quoted,[$"|T],Acc) ->
+ pick_argument(normal,T,[$"|Acc]);
+pick_argument(quoted,[$\\|T],Acc) ->
+ pick_argument(quoted_escaped,T,[$\\|Acc]);
+pick_argument(quoted,[H|T],Acc) ->
+ pick_argument(quoted,T,[H|Acc]);
+pick_argument(normal,[H|T],Acc) ->
+ pick_argument(normal,T,[H|Acc]).
+
+split_helper("Env:",{Where,0}) ->
+ {Where + 1, Where};
+split_helper(_, {Where,Pos}) ->
+ {Where + 1, Pos}.
+
+split_by_env(Data) ->
+ %%% Find Env...
+ case lists:foldl(fun split_helper/2,{0,0},Data) of
+ {_,0} ->
+ %% Not found, hmmmm....
+ {Data,[]};
+ {Len,Pos} ->
+ {lists:sublist(Data,Pos),lists:sublist(Data,Pos+2,Len)}
+ end.
+
+
+splitline(Line) ->
+ case string:chr(Line,$:) of
+ 0 ->
+ {Line, ""};
+ N ->
+ case length(string:substr(Line,N)) of
+ 1 ->
+ {string:substr(Line,1,N-1),""};
+ _ ->
+ {string:substr(Line,1,N-1),string:substr(Line,N+2)}
+ end
+ end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 09:49:43 +0000