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