1%% -*- coding: latin-1 -*-
2%% Copyright (C) 2003 Joakim Greben� <jocke@gleipnir.com>.
3%% All rights reserved.
4%%
5%% Copyright (C) 2006 Gaspar Chilingarov <nm@web.am>
6%%                      Gurgen Tumanyan <barbarian@armkb.com>
7%% All rights reserved.
8%%
9%%
10%% Redistribution and use in source and binary forms, with or without
11%% modification, are permitted provided that the following conditions
12%% are met:
13%%
14%% 1. Redistributions of source code must retain the above copyright
15%%    notice, this list of conditions and the following disclaimer.
16%% 2. Redistributions in binary form must reproduce the above
17%%    copyright notice, this list of conditions and the following
18%%    disclaimer in the documentation and/or other materials provided
19%%    with the distribution.
20%%
21%% THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
22%% OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23%% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
25%% DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
27%% GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
29%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30%% NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33-module(yaws_xmlrpc).
34%%-author('jocke@gleipnir.com').
35-author("Gaspar Chilingarov <nm@web.am>, Gurgen Tumanyan <barbarian@armkb.com>").
36-export([handler/2]).
37-export([handler_session/2, handler_session/3]).
38
39%%-define(debug, 1).
40%%-include("../../yaws/src/yaws_debug.hrl").
41
42-include("../include/yaws_api.hrl").
43
44
45%%% ######################################################################
46%%% public interface
47%%%
48
49%%%
50%%% use XMLRPC handler which can automagically start sessions if we need
51%%%
52handler_session(Args, Handler) ->
53    handler_session(Args, Handler, 'SID').
54
55%%%
56%%% allow overriding session Cookie name
57%%%
58handler_session(Args, Handler, SID_NAME) when is_atom(SID_NAME) ->
59    handler_session(Args, Handler, atom_to_list(SID_NAME));
60
61handler_session(Args, Handler, SID_NAME) ->
62    handler(Args, Handler, {session, SID_NAME}).
63
64%%%
65%%% xmlrpc:handler compatible call
66%%% no session support will be available
67handler(Args, Handler) ->
68    handler(Args, Handler, simple).
69
70
71%%% ######################################################################
72%%% private functions
73%%%
74
75%%% we should be called from yaws page or module
76handler(Args, Handler, Type) when is_record(Args, arg) ->
77    case parse_request(Args) of
78        ok ->
79            handle_payload(Args, Handler, Type);
80        {status, StatusCode} ->        %% cannot parse request
81            send(Args, StatusCode)
82    end.
83
84-define(ERROR_LOG(Reason),
85        error_logger:error_report({?MODULE, ?LINE, Reason})).
86
87%%%
88%%% check that request come in reasonable protocol version and reasonable method
89%%%
90parse_request(Args) -> %% {{{
91    case {(Args#arg.req)#http_request.method,
92          (Args#arg.req)#http_request.version} of
93        {'POST', {1,0}} ->
94            %%        ?Debug("HTTP Version 1.0~n", []),
95            ok;
96        {'POST', {1,1}} ->
97            %%        ?Debug("HTTP Version 1.1~n", []),
98            ok;
99        {'POST', _HTTPVersion} -> {status, 505};
100        {_Method, {1,1}} -> {status, 501};
101        _ -> {status, 400}
102    end. %% }}}
103
104handle_payload(Args, Handler, Type) ->
105    Payload = binary_to_list(Args#arg.clidata),
106    %%    ?Debug("xmlrpc encoded call ~p ~n", [Payload]),
107    case xmlrpc_decode:payload(Payload) of
108        {ok, DecodedPayload} ->
109            %%        ?Debug("xmlrpc decoded call ~p ~n", [DecodedPayload]),
110            eval_payload(Args, Handler, DecodedPayload, Type);
111        {error, Reason} ->
112	    ErrMsg = xmlrpc_http:handle_xmlprc_error(Payload, Reason),
113	    send(Args, 400, ErrMsg, [])
114    end.
115
116%%%%%%
117%%% call handler/3 and provide session support
118eval_payload(Args, {M, F}, Payload, {session, CookieName}) ->
119    {SessionValue, Cookie} =
120        case yaws_api:find_cookie_val(CookieName,
121                                      (Args#arg.headers)#headers.cookie) of
122            [] ->      % have no session started, just call handler
123                {undefined, undefined};
124            Cookie2 -> %% get old session data
125                case yaws_api:cookieval_to_opaque(Cookie2) of
126                    {ok, OP} ->
127                        yaws_api:cookieval_to_opaque(Cookie2),
128                        {OP, Cookie2};
129                    {error, _ErrMsg} -> %% cannot get corresponding session
130                        {undefined, undefined}
131                end
132        end,
133
134    case catch M:F(Args#arg.state, Payload, SessionValue) of
135        {'EXIT', Reason} ->
136            ?ERROR_LOG({M, F, {'EXIT', Reason}}),
137            send(Args, 500);
138        {error, Reason} ->
139            ?ERROR_LOG({M, F, Reason}),
140            send(Args, 500);
141        {false, ResponsePayload} ->
142            %% do not have updates in session data
143            encode_send(Args, 200, ResponsePayload, []);
144        {true, _NewTimeout, NewSessionValue, ResponsePayload} ->
145            %% be compatible with xmlrpc module
146            CO = case NewSessionValue of
147                     undefined when Cookie == undefined -> []; %% nothing to do
148                     undefined -> %% rpc handler requested session delete
149                         yaws_api:delete_cookie_session(Cookie), [];
150                     %% XXX: may be return set-cookie with empty val?
151                     _ ->  %% any other value will stored in session
152                         case SessionValue of
153                             undefined ->
154                                 %% got session data and should start
155                                 %% new session now
156                                 Cookie1 = yaws_api:new_cookie_session(
157                                             NewSessionValue),
158                                 yaws_api:setcookie(
159                                   CookieName, Cookie1, "/");
160                             %% return set_cookie header
161                             _ ->
162                                 yaws_api:replace_cookie_session(
163                                   Cookie, NewSessionValue),
164                                 [] %% nothing to add to yaws data
165                         end
166                 end,
167            encode_send(Args, 200, ResponsePayload, CO)
168    end;
169
170%%%
171%%% call handler/2 without session support
172%%%
173eval_payload(Args, {M, F}, Payload, simple) ->
174    case catch M:F(Args#arg.state, Payload) of
175        {'EXIT', Reason} ->
176            ?ERROR_LOG({M, F, {'EXIT', Reason}}),
177            send(Args, 500);
178        {error, Reason} ->
179            ?ERROR_LOG({M, F, Reason}),
180            send(Args, 500);
181        {false, ResponsePayload} ->
182            encode_send(Args, 200, ResponsePayload, []);
183        {true, _NewTimeout, _NewState, ResponsePayload} ->
184            encode_send(Args, 200, ResponsePayload, [])
185    end.
186
187
188encode_send(Args, StatusCode, Payload, AddOn) ->
189    %%    ?Debug("xmlrpc decoded response ~p ~n", [Payload]),
190    case xmlrpc_encode:payload(Payload) of
191        {ok, EncodedPayload} ->
192            %%   ?Debug("xmlrpc encoded response ~p ~n", [EncodedPayload]),
193            send(Args, StatusCode, EncodedPayload, AddOn);
194        {error, Reason} ->
195            ?ERROR_LOG({xmlrpc_encode, payload, Payload, Reason}),
196            send(Args, 500)
197    end.
198
199send(Args, StatusCode) -> send(Args, StatusCode, "", []).
200
201send(Args, StatusCode, Payload, AddOnData) when not is_list(AddOnData) ->
202    send(Args, StatusCode, Payload, [AddOnData]);
203
204%%%
205%%% generate valid yaws response
206send(_Args, StatusCode, Payload, AddOnData) ->
207    A = [
208         {status, StatusCode},
209         {content, "text/xml", Payload},
210         {header, {content_length, lists:flatlength(Payload) }}
211        ] ++ AddOnData,
212    A.
213
214