%%%------------------------------------------------------------------- %%% Created : 29 Nov 2006 by Torbjorn Tornkvist %%% Author : Willem de Jong (w.a.de.jong@gmail.com). %%% Desc : A SOAP server. %%%------------------------------------------------------------------- -module(detergent_server). -behaviour(gen_server). %% API -export([start_link/0, start_link/1, setup/1, setup/2, setup/3 ]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -include_lib("detergent.hrl"). -define(SERVER, ?MODULE). %% State -record(s, { wsdl_list = [] % list of {Id, WsdlModel} tuples, where Id == {M,F} }). -define(OK_CODE, 200). -define(BAD_MESSAGE_CODE, 400). %% -define(METHOD_NOT_ALLOWED_CODE, 405). -define(SERVER_ERROR_CODE, 500). %%==================================================================== %% API %%==================================================================== %%-------------------------------------------------------------------- %% Function: start_link() -> {ok,Pid} | ignore | {error,Error} %% Description: Starts the server %%-------------------------------------------------------------------- start_link() -> start_link([]). start_link(L) -> %% We are dependent on erlsom case code:ensure_loaded(erlsom) of {error, _} -> Emsg = "could not load erlsom", error_logger:error_msg("~p: exiting, reason: ~s~n", [?MODULE, Emsg]), {error, Emsg}; {module, erlsom} -> gen_server:start_link({local, ?SERVER}, ?MODULE, L, []) end. %% Setup a SOAP interface according to the config file. setup(_ConfigFile) -> tbd. setup(Id, WsdlFile) when is_tuple(Id),size(Id)==2 -> Wsdl = detergent:initModel(WsdlFile), gen_server:call(?SERVER, {add_wsdl, Id, Wsdl}, infinity). setup(Id, WsdlFile, Prefix) when is_tuple(Id),size(Id)==2 -> Wsdl = detergent:initModel(WsdlFile, Prefix), gen_server:call(?SERVER, {add_wsdl, Id, Wsdl}, infinity). %%==================================================================== %% gen_server callbacks %%==================================================================== %%-------------------------------------------------------------------- %% Function: init(Args) -> {ok, State} | %% {ok, State, Timeout} | %% ignore | %% {stop, Reason} %% Description: Initiates the server %%-------------------------------------------------------------------- init(L) -> %% [ {{Mod,Handler}, WsdlFile} ] WsdlList = lists:foldl( fun( SoapSrvMod, OldList) -> setup_on_init( SoapSrvMod, OldList ) end,[],L), {ok, #s{wsdl_list = WsdlList}}. setup_on_init( {Id, WsdlFile}, OldList ) when is_tuple(Id),size(Id)==2 -> Wsdl = detergent:initModel(WsdlFile), uinsert({Id, Wsdl}, OldList); setup_on_init( {Id, WsdlFile, Prefix}, OldList ) when is_tuple(Id),size(Id)==2 -> Wsdl = detergent:initModel(WsdlFile, Prefix), uinsert({Id, Wsdl}, OldList). %%-------------------------------------------------------------------- %% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} | %% {reply, Reply, State, Timeout} | %% {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, Reply, State} | %% {stop, Reason, State} %% Description: Handling call messages %%-------------------------------------------------------------------- handle_call({add_wsdl, Id, WsdlModel}, _From, State) -> NewWsdlList = uinsert({Id, WsdlModel}, State#s.wsdl_list), {reply, ok, State#s{wsdl_list = NewWsdlList}}; %% handle_call( {request, Id, Payload, SessionValue, SoapAction}, _From, State) -> Reply = request(State, Id, Payload, SessionValue, SoapAction), {reply, Reply, State}. %%-------------------------------------------------------------------- %% Function: handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% Description: Handling cast messages %%-------------------------------------------------------------------- handle_cast(_Msg, State) -> {noreply, State}. %%-------------------------------------------------------------------- %% Function: handle_info(Info, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% Description: Handling all non call/cast messages %%-------------------------------------------------------------------- handle_info(_Info, State) -> {noreply, State}. %%-------------------------------------------------------------------- %% Function: terminate(Reason, State) -> void() %% Description: This function is called by a gen_server when it is about to %% terminate. It should be the opposite of Module:init/1 and do any necessary %% cleaning up. When it returns, the gen_server terminates with Reason. %% The return value is ignored. %%-------------------------------------------------------------------- terminate(_Reason, _State) -> ok. %%-------------------------------------------------------------------- %% Func: code_change(OldVsn, State, Extra) -> {ok, NewState} %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- code_change(_OldVsn, State, _Extra) -> {ok, State}. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- request(State, {M,F} = Id, {Req, Attachments}, SessionValue, Action) -> {ok, Model} = get_model(State, Id), %%error_logger:info_report([?MODULE, {payload, Req}]), case catch detergent:parseMessage(Req, Model) of {ok, Header, Body} -> %% call function result(Model, catch apply(M, F, [Header, Body, Action, SessionValue, Attachments])); {error, Error} -> cli_error(Error); OtherError -> srv_error(io_lib:format("Error parsing message: ~p", [OtherError])) end; request(State, {M,F} = Id, Req, SessionValue, Action) -> %%error_logger:info_report([?MODULE, {payload, Req}]), {ok, Model} = get_model(State, Id), Umsg = (catch erlsom_lib:toUnicode(Req)), case catch detergent:parseMessage(Umsg, Model) of {ok, Header, Body} -> %% call function result(Model, catch apply(M, F, [Header, Body, Action, SessionValue])); {error, Error} -> cli_error(Error); OtherError -> srv_error(io_lib:format("Error parsing message: ~p", [OtherError])) end. %%% Analyse the result and produce some output result(Model, {ok, ResHeader, ResBody, ResCode, SessVal}) -> return(Model, ResHeader, ResBody, ResCode, SessVal, undefined); result(Model, {ok, ResHeader, ResBody}) -> return(Model, ResHeader, ResBody, ?OK_CODE, undefined, undefined); result(Model, {ok, ResHeader, ResBody, Files}) -> return(Model, ResHeader, ResBody, ?OK_CODE, undefined, Files); result(_Model, {error, client, ClientMssg}) -> cli_error(ClientMssg); result(_Model, false) -> % soap notify ! false; result(_Model, Error) -> srv_error(io_lib:format("Error processing message: ~p", [Error])). return(#wsdl{model = Model}, ResHeader, ResBody, ResCode, SessVal, Files) -> return(Model, ResHeader, ResBody, ResCode, SessVal, Files); return(Model, ResHeader, ResBody, ResCode, SessVal, Files) when not is_list(ResBody) -> return(Model, ResHeader, [ResBody], ResCode, SessVal, Files); return(Model, ResHeader, ResBody, ResCode, SessVal, Files) -> %% add envelope Header2 = case ResHeader of undefined -> undefined; _ -> #'soap:Header'{choice = ResHeader} end, Envelope = #'soap:Envelope'{'Body' = #'soap:Body'{choice = ResBody}, 'Header' = Header2}, case catch erlsom:write(Envelope, Model) of {ok, XmlDoc} -> case Files of undefined -> {ok, XmlDoc, ResCode, SessVal}; _ -> DIME = detergent_dime:encode(XmlDoc, Files), {ok, DIME, ResCode, SessVal} end; {error, WriteError} -> srv_error(f("Error writing XML: ~p", [WriteError])); OtherWriteError -> error_logger:error_msg("~p(~p): OtherWriteError=~p~n", [?MODULE, ?LINE, OtherWriteError]), srv_error(f("Error writing XML: ~p", [OtherWriteError])) end. f(S,A) -> lists:flatten(io_lib:format(S,A)). cli_error(Error) -> error_logger:error_msg("~p(~p): Cli Error: ~p~n", [?MODULE, ?LINE, Error]), Fault = detergent:makeFault("Client", "Client error"), {error, Fault, ?BAD_MESSAGE_CODE}. srv_error(Error) -> error_logger:error_msg("~p(~p): Srv Error: ~p~n", [?MODULE, ?LINE, Error]), Fault = detergent:makeFault("Server", "Server error"), {error, Fault, ?SERVER_ERROR_CODE}. get_model(State, Id) -> case lists:keysearch(Id, 1, State#s.wsdl_list) of {value, {_, Model}} -> {ok, Model}; _ -> {error, "model not found"} end. uinsert({K,_} = E, [{K,_}|T]) -> [E|T]; uinsert(E, [H|T]) -> [H|uinsert(E,T)]; uinsert(E, []) -> [E].