The R13B03 release.OTP_R13B03

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.