1%% ``Licensed under the Apache License, Version 2.0 (the "License");
2%% you may not use this file except in compliance with the License.
3%% You may obtain a copy of the License at
4%%
5%%     http://www.apache.org/licenses/LICENSE-2.0
6%%
7%% Unless required by applicable law or agreed to in writing, software
8%% distributed under the License is distributed on an "AS IS" BASIS,
9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10%% See the License for the specific language governing permissions and
11%% limitations under the License.
12%%
13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
15%% AB. All Rights Reserved.''
16%%
17%%     $Id: mod_esi.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
18%%
19-module(mod_esi).
20-export([do/1,load/2]).
21
22%%Functions provided to help erl scheme alias programmer to
23%%Create dynamic webpages that are sent back to the user during
24%%Generation
25-export([deliver/2]).
26
27
28-include("httpd.hrl").
29
30-define(VMODULE,"ESI").
31-include("httpd_verbosity.hrl").
32
33-define(GATEWAY_INTERFACE,"CGI/1.1").
34-define(DEFAULT_ERL_TIMEOUT,15000).
35%% do
36
37do(Info) ->
38    ?vtrace("do",[]),
39    case httpd_util:key1search(Info#mod.data,status) of
40	%% A status code has been generated!
41	{StatusCode,PhraseArgs,Reason} ->
42	    {proceed,Info#mod.data};
43	%% No status code has been generated!
44	undefined ->
45	    case httpd_util:key1search(Info#mod.data,response) of
46		%% No response has been generated!
47		undefined ->
48		    case erl_or_eval(Info#mod.request_uri,
49				     Info#mod.config_db) of
50			{eval,CGIBody,Modules} ->
51			    eval(Info,Info#mod.method,CGIBody,Modules);
52			{erl,CGIBody,Modules} ->
53			    erl(Info,Info#mod.method,CGIBody,Modules);
54			proceed ->
55			    {proceed,Info#mod.data}
56		    end;
57		%% A response has been generated or sent!
58		Response ->
59		    {proceed,Info#mod.data}
60	    end
61    end.
62
63
64
65%% erl_or_eval
66
67erl_or_eval(RequestURI, ConfigDB) ->
68    case erlp(RequestURI, ConfigDB) of
69	false ->
70	    case evalp(RequestURI, ConfigDB) of
71		false ->
72		    ?vtrace("neither erl nor eval",[]),
73		    proceed;
74		Other ->
75		    Other
76	    end;
77	Other ->
78	    Other
79    end.
80
81erlp(RequestURI, ConfigDB) ->
82    case httpd_util:multi_lookup(ConfigDB, erl_script_alias) of
83	[] ->
84	    false;
85	AliasMods ->
86	    erlp_find_alias(RequestURI,AliasMods)
87    end.
88
89erlp_find_alias(_RequestURI,[]) ->
90    ?vtrace("erlp_find_alias -> no match",[]),
91    false;
92erlp_find_alias(RequestURI,[{Alias,Modules}|Rest]) ->
93    case regexp:first_match(RequestURI,"^"++Alias++"/") of
94	{match,1,Length} ->
95	    ?vtrace("erlp -> match with Length: ~p",[Length]),
96	    {erl,string:substr(RequestURI,Length+1),Modules};
97	nomatch ->
98	    erlp_find_alias(RequestURI,Rest)
99    end.
100
101evalp(RequestURI, ConfigDB) ->
102    case httpd_util:multi_lookup(ConfigDB, eval_script_alias) of
103	[] ->
104	    false;
105	AliasMods ->
106	    evalp_find_alias(RequestURI,AliasMods)
107    end.
108
109evalp_find_alias(_RequestURI,[]) ->
110    ?vtrace("evalp_find_alias -> no match",[]),
111    false;
112evalp_find_alias(RequestURI,[{Alias,Modules}|Rest]) ->
113    case regexp:first_match(RequestURI,"^"++Alias++"\\?") of
114	{match, 1, Length} ->
115	    ?vtrace("evalp_find_alias -> match with Length: ~p",[Length]),
116	    {eval, string:substr(RequestURI,Length+1),Modules};
117	nomatch ->
118	    evalp_find_alias(RequestURI,Rest)
119    end.
120
121
122%%
123%% Erl mechanism
124%%
125
126%%This is exactly the same as the GET method the difference is that
127%%The response must not contain any data expect the response header
128
129
130erl(Info,"HEAD",CGIBody,Modules) ->
131    erl(Info,"GET",CGIBody,Modules);
132
133erl(Info,"GET",CGIBody,Modules) ->
134    ?vtrace("erl GET request",[]),
135    case httpd_util:split(CGIBody,":|%3A|/",2) of
136	{ok, [Mod,FuncAndInput]} ->
137	    ?vtrace("~n   Mod:          ~p"
138		    "~n   FuncAndInput: ~p",[Mod,FuncAndInput]),
139	    case httpd_util:split(FuncAndInput,"[\?/]",2) of
140		{ok, [Func,Input]} ->
141		    ?vtrace("~n   Func:  ~p"
142			    "~n   Input: ~p",[Func,Input]),
143		    exec(Info,"GET",CGIBody,Modules,Mod,Func,
144			 {input_type(FuncAndInput),Input});
145		{ok, [Func]} ->
146		    exec(Info,"GET",CGIBody,Modules,Mod,Func,{no_input,""});
147		{ok, BadRequest} ->
148		    {proceed,[{status,{400,none,BadRequest}}|Info#mod.data]}
149	    end;
150	{ok, BadRequest} ->
151	    ?vlog("erl BAD (GET-) request",[]),
152	    {proceed, [{status,{400,none,BadRequest}}|Info#mod.data]}
153    end;
154
155erl(Info, "POST", CGIBody, Modules) ->
156    ?vtrace("erl POST request",[]),
157    case httpd_util:split(CGIBody,":|%3A|/",2) of
158	{ok,[Mod,Func]} ->
159	    ?vtrace("~n   Mod:  ~p"
160		    "~n   Func: ~p",[Mod,Func]),
161	    exec(Info,"POST",CGIBody,Modules,Mod,Func,
162		 {entity_body,Info#mod.entity_body});
163	{ok,BadRequest} ->
164	    ?vlog("erl BAD (POST-) request",[]),
165	    {proceed,[{status,{400,none,BadRequest}}|Info#mod.data]}
166    end.
167
168input_type([]) ->
169    no_input;
170input_type([$/|Rest]) ->
171    path_info;
172input_type([$?|Rest]) ->
173    query_string;
174input_type([First|Rest]) ->
175    input_type(Rest).
176
177
178%% exec
179
180exec(Info,Method,CGIBody,["all"],Mod,Func,{Type,Input}) ->
181    ?vtrace("exec ~s 'all'",[Method]),
182    exec(Info,Method,CGIBody,[Mod],Mod,Func,{Type,Input});
183exec(Info,Method,CGIBody,Modules,Mod,Func,{Type,Input}) ->
184    ?vtrace("exec ~s request with:"
185	    "~n   Modules: ~p"
186	    "~n   Mod:     ~p"
187	    "~n   Func:    ~p"
188	    "~n   Type:    ~p"
189	    "~n   Input:   ~p",
190	    [Method,Modules,Mod,Func,Type,Input]),
191    case lists:member(Mod,Modules) of
192	true ->
193	    {_,RemoteAddr}=(Info#mod.init_data)#init_data.peername,
194	    ServerName=(Info#mod.init_data)#init_data.resolve,
195	    Env=get_environment(Info,ServerName,Method,RemoteAddr,Type,Input),
196	    ?vtrace("and now call the module",[]),
197	    case try_new_erl_scheme_method(Info,Env,Input,list_to_atom(Mod),list_to_atom(Func)) of
198		{error,not_new_method}->
199		    case catch apply(list_to_atom(Mod),list_to_atom(Func),[Env,Input]) of
200			{'EXIT',Reason} ->
201			    ?vlog("exit with Reason: ~p",[Reason]),
202			    {proceed,[{status,{500,none,Reason}}|Info#mod.data]};
203			Response ->
204			    control_response_header(Info,Mod,Func,Response)
205		    end;
206		ResponseResult->
207		    ResponseResult
208	    end;
209	false ->
210	    ?vlog("unknown module",[]),
211	    {proceed,[{status,{403,Info#mod.request_uri,
212			       ?NICE("Client not authorized to evaluate: "++CGIBody)}}|Info#mod.data]}
213    end.
214
215control_response_header(Info,Mod,Func,Response)->
216    case control_response(Response,Info,Mod,Func) of
217	{proceed,[{response,{StatusCode,Response}}|Rest]} ->
218	    case httpd_util:lookup(Info#mod.config_db,erl_script_nocache,false) of
219		true ->
220		    case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
221			{ok,[Head,Body]}->
222			    Date=httpd_util:rfc1123_date(),
223			    Cache="Cache-Control:no-cache\r\nPragma:no-cache\r\nExpires:"++ Date ++ "\r\n",
224			    {proceed,[{response,{StatusCode,[Head,"\r\n",Cache,"\r\n",Body]}}|Rest]};
225			_->
226			   {proceed,[{response,{StatusCode,Response}}|Rest]}
227		    end;
228		WhatEver->
229		    {proceed,[{response,{StatusCode,Response}}|Rest]}
230	    end;
231	WhatEver->
232	    WhatEver
233    end.
234
235control_response(Response,Info,Mod,Func)->
236    ?vdebug("Response: ~n~p",[Response]),
237    case mod_cgi:status_code(lists:flatten(Response)) of
238	{ok,StatusCode} ->
239	    {proceed,[{response,{StatusCode,Response}}|Info#mod.data]};
240	{error,Reason} ->
241	    {proceed,
242	     [{status,{400,none,
243		       ?NICE("Error in "++Mod++":"++Func++"/2: "++
244			     lists:flatten(io_lib:format("~p",[Reason])))}}|
245	      Info#mod.data]}
246    end.
247
248parsed_header([]) ->
249    [];
250parsed_header([{Name,[Value|R1]}|R2]) when list(Value) ->
251    NewName=lists:map(fun(X) -> if X == $- -> $_; true -> X end end,Name),
252    [{list_to_atom("http_"++httpd_util:to_lower(NewName)),
253      multi_value([Value|R1])}|parsed_header(R2)];
254parsed_header([{Name,Value}|Rest]) when list(Value)->
255    {ok,NewName,_}=regexp:gsub(Name,"-","_"),
256    [{list_to_atom("http_"++httpd_util:to_lower(NewName)),Value}|
257     parsed_header(Rest)].
258
259multi_value([]) ->
260    [];
261multi_value([Value]) ->
262    Value;
263multi_value([Value|Rest]) ->
264    Value++", "++multi_value(Rest).
265
266%%
267%% Eval mechanism
268%%
269
270
271eval(Info,"POST",CGIBody,Modules) ->
272    ?vtrace("eval(POST) -> method not supported",[]),
273    {proceed,[{status,{501,{"POST",Info#mod.request_uri,Info#mod.http_version},
274		       ?NICE("Eval mechanism doesn't support method POST")}}|
275	      Info#mod.data]};
276
277eval(Info,"HEAD",CGIBody,Modules) ->
278    %%The function that sends the data in httpd_response handles HEAD reqest by not
279    %% Sending the body
280    eval(Info,"GET",CGIBody,Modules);
281
282
283eval(Info,"GET",CGIBody,Modules) ->
284    ?vtrace("eval(GET) -> entry when"
285	    "~n   Modules: ~p",[Modules]),
286    case auth(CGIBody,Modules) of
287	true ->
288	    case erl_eval:eval_str(string:concat(CGIBody,". ")) of
289		{error,Reason} ->
290		    ?vlog("eval -> error:"
291			  "~n   Reason: ~p",[Reason]),
292		    {proceed,[{status,{500,none,Reason}}|Info#mod.data]};
293		{ok,Response} ->
294		    ?vtrace("eval -> ok:"
295			    "~n   Response: ~p",[Response]),
296		    case mod_cgi:status_code(lists:flatten(Response)) of
297			{ok,StatusCode} ->
298			    {proceed,[{response,{StatusCode,Response}}|Info#mod.data]};
299			{error,Reason} ->
300			    {proceed,[{status,{400,none,Reason}}|Info#mod.data]}
301		    end
302	    end;
303	false ->
304	    ?vlog("eval -> auth failed",[]),
305	    {proceed,[{status,
306		       {403,Info#mod.request_uri,
307			?NICE("Client not authorized to evaluate: "++CGIBody)}}|
308		      Info#mod.data]}
309    end.
310
311auth(CGIBody,["all"]) ->
312    true;
313auth(CGIBody,Modules) ->
314    case regexp:match(CGIBody,"^[^\:(%3A)]*") of
315	{match,Start,Length} ->
316	    lists:member(string:substr(CGIBody,Start,Length),Modules);
317	nomatch ->
318	    false
319    end.
320
321%%----------------------------------------------------------------------
322%%Creates the environment list that will be the first arg to the
323%%Functions that is called through the ErlScript Schema
324%%----------------------------------------------------------------------
325
326get_environment(Info,ServerName,Method,RemoteAddr,Type,Input)->
327    Env=[{server_software,?SERVER_SOFTWARE},
328		 {server_name,ServerName},
329		 {gateway_interface,?GATEWAY_INTERFACE},
330		 {server_protocol,?SERVER_PROTOCOL},
331		 {server_port,httpd_util:lookup(Info#mod.config_db,port,80)},
332		 {request_method,Method},
333		 {remote_addr,RemoteAddr},
334		 {script_name,Info#mod.request_uri}|
335		 parsed_header(Info#mod.parsed_header)],
336    get_environment(Type,Input,Env,Info).
337
338
339get_environment(Type,Input,Env,Info)->
340    Env1=case Type of
341	query_string ->
342	    [{query_string,Input}|Env];
343	path_info ->
344	    Aliases=httpd_util:multi_lookup(Info#mod.config_db,alias),
345	    {_,PathTranslated,_}=mod_alias:real_name(Info#mod.config_db,[$/|Input],Aliases),
346	    [{path_info,"/"++httpd_util:decode_hex(Input)},
347	     {path_translated,PathTranslated}|Env];
348	entity_body ->
349	    [{content_length,httpd_util:flatlength(Input)}|Env];
350	no_input ->
351	    Env
352    end,
353    get_environment(Info,Env1).
354
355get_environment(Info,Env)->
356    case httpd_util:key1search(Info#mod.data,remote_user) of
357	undefined ->
358	    Env;
359	RemoteUser ->
360	    [{remote_user,RemoteUser}|Env]
361    end.
362%%
363%% Configuration
364%%
365
366%% load
367
368load([$E,$r,$l,$S,$c,$r,$i,$p,$t,$A,$l,$i,$a,$s,$ |ErlScriptAlias],[]) ->
369    case regexp:split(ErlScriptAlias," ") of
370	{ok, [ErlName|Modules]} ->
371	    {ok, [], {erl_script_alias, {ErlName,Modules}}};
372	{ok, _} ->
373	    {error,?NICE(httpd_conf:clean(ErlScriptAlias)++
374			 " is an invalid ErlScriptAlias")}
375    end;
376load([$E,$v,$a,$l,$S,$c,$r,$i,$p,$t,$A,$l,$i,$a,$s,$ |EvalScriptAlias],[]) ->
377    case regexp:split(EvalScriptAlias, " ") of
378	{ok, [EvalName|Modules]} ->
379	    {ok, [], {eval_script_alias, {EvalName,Modules}}};
380	{ok, _} ->
381	    {error, ?NICE(httpd_conf:clean(EvalScriptAlias)++
382			  " is an invalid EvalScriptAlias")}
383    end;
384load([$E,$r,$l,$S,$c,$r,$i,$p,$t,$T,$i,$m,$e,$o,$u,$t,$ |Timeout],[])->
385    case catch list_to_integer(httpd_conf:clean(Timeout)) of
386	TimeoutSec when integer(TimeoutSec)  ->
387	   {ok, [], {erl_script_timeout,TimeoutSec*1000}};
388	_ ->
389	   {error, ?NICE(httpd_conf:clean(Timeout)++
390			 " is an invalid ErlScriptTimeout")}
391    end;
392load([$E,$r,$l,$S,$c,$r,$i,$p,$t,$N,$o,$C,$a,$c,$h,$e |CacheArg],[])->
393    case catch list_to_atom(httpd_conf:clean(CacheArg)) of
394        true ->
395	    {ok, [], {erl_script_nocache,true}};
396	false ->
397	   {ok, [], {erl_script_nocache,false}};
398	_ ->
399	   {error, ?NICE(httpd_conf:clean(CacheArg)++
400			 " is an invalid ErlScriptNoCache directive")}
401    end.
402
403
404
405
406%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
407%%                                                                    %%
408%% Functions below handles the data from the dynamic webpages         %%
409%% That sends data back to the user part by part                      %%
410%%                                                                    %%
411%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
412
413%%----------------------------------------------------------------------
414%%Deliver is the callback function users can call to deliver back data to the
415%%client
416%%----------------------------------------------------------------------
417
418deliver(SessionID,Data)when pid(SessionID) ->
419    SessionID ! {ok,Data},
420    ok;
421deliver(SessionID,Data) ->
422    {error,bad_sessionID}.
423
424
425%%----------------------------------------------------------------------
426%% The method that tries to execute the new format
427%%----------------------------------------------------------------------
428
429%%It would be nicer to use erlang:function_exported/3 but if the
430%%Module isn't loaded the function says that it is not loaded
431
432
433try_new_erl_scheme_method(Info,Env,Input,Mod,Func)->
434    process_flag(trap_exit,true),
435    Pid=spawn_link(Mod,Func,[self(),Env,Input]),
436    Timeout=httpd_util:lookup(Info#mod.config_db,erl_script_timeout,?DEFAULT_ERL_TIMEOUT),
437    RetVal=receive_response_data(Info,Pid,0,undefined,[],Timeout),
438    process_flag(trap_exit,false),
439    RetVal.
440
441
442%%----------------------------------------------------------------------
443%%The function receives the data from the process that generates the page
444%%and send the data to the client through the mod_cgi:send function
445%%----------------------------------------------------------------------
446
447receive_response_data(Info,Pid,Size,StatusCode,AccResponse,Timeout) ->
448    ?DEBUG("receive_response_data()-> Script Size: ~p,StatusCode ~p ,Timeout: ~p ~n",[Size,StatusCode,Timeout]),
449    receive
450	{ok, Response} ->
451	    NewStatusCode=mod_cgi:update_status_code(StatusCode,Response),
452
453	    ?DEBUG("receive_response_data/2 NewStatusCode: ~p~n",[NewStatusCode]),
454	    case mod_cgi:send(Info, NewStatusCode,Response, Size,AccResponse) of
455		socket_closed ->
456		    (catch exit(Pid,final)),
457		    {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]};
458		head_sent->
459		    (catch exit(Pid,final)),
460		    {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]};
461		_ ->
462		    %%The data is sent and the socket is not closed contine
463		    NewSize = mod_cgi:get_new_size(Size,Response),
464		    receive_response_data(Info,Pid,NewSize,NewStatusCode,"notempty",Timeout)
465	    end;
466	{'EXIT', Pid, Reason} when AccResponse==[] ->
467	    {error,not_new_method};
468	{'EXIT', Pid, Reason} when pid(Pid) ->
469	    NewStatusCode=mod_cgi:update_status_code(StatusCode,AccResponse),
470	    mod_cgi:final_send(Info,NewStatusCode,Size,AccResponse),
471	    {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]};
472	%% This should not happen!
473	WhatEver ->
474	    NewStatusCode=mod_cgi:update_status_code(StatusCode,AccResponse),
475	    mod_cgi:final_send(Info,StatusCode,Size,AccResponse),
476	    {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]}
477    after
478	Timeout ->
479	    (catch exit(Pid,timeout)), % KILL the port !!!!
480	    httpd_socket:close(Info#mod.socket_type,Info#mod.socket),
481	    {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]}
482    end.
483