mod_include.erl

OTP是开放电信平台的简称

			      [httpd_util:day(
				 calendar:day_of_the_week(Yr,Mon, Day)),
			       httpd_util:month(Mon),Day,Hour,Minute,Second, Yr]),
	    {ok, Context, ErrorLog, Result, R};
	{error, _Reason} ->
	    {ok,Context,[{internal_info,?NICE("Can't open "++File)}|ErrorLog],
	     httpd_util:key1search(Context,errmsg,""),R}
    end.

%%
%% exec directive
%%

exec(Info,Context,ErrorLog,[cmd],[Command],R) ->
    cmd(Info,Context,ErrorLog,R,Command);
exec(Info,Context,ErrorLog,[cgi],[RequestURI],R) ->
    cgi(Info,Context,ErrorLog,R,RequestURI);
exec(_Info, Context, ErrorLog, _TagList, _ValueList, R) ->
    {ok, Context,
     [{internal_info,?NICE("exec directive has a spurious tag")}|
      ErrorLog], httpd_util:key1search(Context,errmsg,""),R}.

%% cmd

cmd(Info, Context, ErrorLog, R, Command) ->
    process_flag(trap_exit,true),    
    Env  = env(Info),
    Dir  = filename:dirname(Command),
    Port = (catch open_port({spawn,Command},[stream,{cd,Dir},{env,Env}])),
    case Port of
	P when port(P) ->
	    {NewErrorLog, Result} = proxy(Port, ErrorLog),
	    {ok, Context, NewErrorLog, Result, R};
	{'EXIT', Reason} ->
	    exit({open_port_failed,Reason,
		  [{uri,Info#mod.request_uri},{script,Command},
		   {env,Env},{dir,Dir}]});
	O ->
	    exit({open_port_failed,O,
		  [{uri,Info#mod.request_uri},{script,Command},
		   {env,Env},{dir,Dir}]})
    end.

env(Info) ->
    [{"DOCUMENT_NAME",document_name(Info#mod.data,Info#mod.config_db,
				    Info#mod.request_uri)},
     {"DOCUMENT_URI", document_uri(Info#mod.config_db, Info#mod.request_uri)},
     {"QUERY_STRING_UNESCAPED", query_string_unescaped(Info#mod.request_uri)},
     {"DATE_LOCAL", date_local()},
     {"DATE_GMT", date_gmt()},
     {"LAST_MODIFIED", last_modified(Info#mod.data, Info#mod.config_db,
				     Info#mod.request_uri)}
    ].

%% cgi

cgi(Info, Context, ErrorLog, R, RequestURI) ->
    ScriptAliases = httpd_util:multi_lookup(Info#mod.config_db, script_alias),
    case mod_alias:real_script_name(Info#mod.config_db, RequestURI,
				    ScriptAliases) of
	{Script, AfterScript} ->
	    exec_script(Info,Script,AfterScript,ErrorLog,Context,R);
	not_a_script ->
	    {ok, Context,
	     [{internal_info, ?NICE(RequestURI++" is not a script")}|
	      ErrorLog], httpd_util:key1search(Context, errmsg, ""),R}
    end.

remove_header([]) ->
    [];
remove_header([$\n,$\n|Rest]) ->
    Rest;
remove_header([_C|Rest]) ->
    remove_header(Rest).


exec_script(#mod{config_db = Db, request_uri = RequestUri} = Info, 
	    Script, _AfterScript, ErrorLog, Context, R) ->
    process_flag(trap_exit,true),    
    Aliases = httpd_util:multi_lookup(Db, alias),
    {_, Path, AfterPath} = mod_alias:real_name(Db, RequestUri, Aliases),
    Env  = env(Info) ++ mod_cgi:env(Info, Path, AfterPath),
    Dir  = filename:dirname(Path),
    Port = (catch open_port({spawn,Script},[stream,{env, Env},{cd, Dir}])),
    case Port of
	P when port(P) ->
	    %% Send entity body to port.
	    Res = case Info#mod.entity_body of
		      [] ->
			  true;
		      EntityBody ->
			  (catch port_command(Port, EntityBody))
		  end,
	    case Res of
		{'EXIT', Reason} ->
		    exit({open_cmd_failed,Reason,
			  [{mod,?MODULE},{port,Port},
			   {uri,RequestUri},
			   {script,Script},{env,Env},{dir,Dir},
			   {ebody_size,sz(Info#mod.entity_body)}]});
		true ->
		    {NewErrorLog, Result} = proxy(Port, ErrorLog),
		    {ok, Context, NewErrorLog, remove_header(Result), R}
	    end;
	{'EXIT', Reason} ->
	    exit({open_port_failed,Reason,
		  [{mod,?MODULE},{uri,RequestUri},{script,Script},
		   {env,Env},{dir,Dir}]});
	O ->
	    exit({open_port_failed,O,
		  [{mod,?MODULE},{uri,RequestUri},{script,Script},
		   {env,Env},{dir,Dir}]})
    end.
    

%%
%% Port communication
%%

proxy(Port, ErrorLog) ->
    process_flag(trap_exit, true),
    proxy(Port, ErrorLog, []).

proxy(Port, ErrorLog, Result) ->
    receive
	{Port, {data, Response}} ->
	    proxy(Port, ErrorLog, lists:append(Result,Response));
	{'EXIT', Port, normal} when port(Port) ->
	    process_flag(trap_exit, false),
	    {ErrorLog, Result};
	{'EXIT', Port, _Reason} when port(Port) ->
	    process_flag(trap_exit, false),
	    {[{internal_info,
	       ?NICE("Scrambled output from CGI-script")}|ErrorLog],
	     Result};
	{'EXIT', Pid, Reason} when pid(Pid) ->
	    process_flag(trap_exit, false),
	    {'EXIT', Pid, Reason};
	%% This should not happen!
	_WhatEver ->
	    process_flag(trap_exit, false),
	    {ErrorLog, Result}
    end.


%% ------
%% Temporary until I figure out a way to fix send_in_chunks
%% (comments and directives that start in one chunk but end
%% in another is not handled).
%%

send_in(Info, Path, Head, {ok,FileInfo}) ->
    case file:read_file(Path) of
	{ok, Bin} ->
	    send_in1(Info, binary_to_list(Bin), Head, FileInfo);
	{error, Reason} ->
	    {error, {read,Reason}}
    end;
send_in(_Info , _Path, _Head,{error,Reason}) ->
    {error, {open,Reason}}.

send_in1(Info, Data, Head, FileInfo) ->
    {ok, _Context, Err, ParsedBody} = parse(Info,Data,?DEFAULT_CONTEXT,[],[]),
    Size = length(ParsedBody),
    LastModified = case catch httpd_util:rfc1123_date(FileInfo#file_info.mtime) of
		       Date when list(Date) -> [{last_modified,Date}];
		       _ -> []
		   end,
    Head1 = case Info#mod.http_version of 
		"HTTP/1.1"->
		    Head ++ [{content_length, integer_to_list(Size)},  
			     {etag, httpd_util:create_etag(FileInfo,Size)}|
			     LastModified];
		_->
		    %% i.e http/1.0 and http/0.9
		    Head ++  [{content_length, integer_to_list(Size)}|  
			      LastModified]
	    end,
    httpd_response:send_header(Info, 200, Head1),
    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket, ParsedBody),
    {ok, Err, Size}.


parse(Info,Body) ->
  parse(Info, Body, ?DEFAULT_CONTEXT, [], []).

parse(_Info, [], Context, ErrorLog, Result) ->
    {ok, Context, lists:reverse(ErrorLog), lists:reverse(Result)};
parse(Info,[$<,$!,$-,$-,$#|R1],Context,ErrorLog,Result) ->
  case catch parse0(R1,Context) of
    {parse_error,Reason} ->
      parse(Info,R1,Context,[{internal_info,?NICE(Reason)}|ErrorLog],
	    [$#,$-,$-,$!,$<|Result]);
    {ok,Context,Command,TagList,ValueList,R2} ->
	  {ok,NewContext,NewErrorLog,MoreResult,R3}=
	      handle(Info,Context,ErrorLog,Command,TagList,ValueList,R2),
	  parse(Info,R3,NewContext,NewErrorLog,
		lists:reverse(MoreResult)++Result)
  end;
parse(Info,[$<,$!,$-,$-|R1],Context,ErrorLog,Result) ->
  case catch parse5(R1,[],0) of
    {parse_error,Reason} ->
	  parse(Info,R1,Context,
		[{internal_info,?NICE(Reason)}|ErrorLog],Result);
      {Comment,R2} ->
      parse(Info,R2,Context,ErrorLog,Comment++Result)
  end;
parse(Info,[C|R],Context,ErrorLog,Result) ->
  parse(Info,R,Context,ErrorLog,[C|Result]).

handle(Info,Context,ErrorLog,Command,TagList,ValueList,R) ->
  case catch apply(?MODULE,Command,[Info,Context,ErrorLog,TagList,ValueList,
				    R]) of
    {'EXIT',{undef,_}} ->
      throw({parse_error,"Unknown command "++atom_to_list(Command)++
	     " in parsed doc"});
    Result ->
      Result
  end.

parse0([], _Context) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse0([$-,$-,$>|_R], _Context) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse0([$ |R], Context) ->
  parse0(R,Context);
parse0(String, Context) ->
  parse1(String, Context,"").

parse1([], _Context, _Command) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse1([$-,$-,$>|_R], _Context, _Command) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse1([$ |R], Context, Command) ->
  parse2(R,Context,list_to_atom(lists:reverse(Command)),[],[],"");
parse1([C|R], Context, Command) ->
  parse1(R,Context,[C|Command]).

parse2([], _Context, _Command, _TagList, _ValueList, _Tag) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse2([$-,$-,$>|R], Context, Command, TagList, ValueList, _Tag) ->
  {ok,Context,Command,TagList,ValueList,R};
parse2([$ |R],Context,Command,TagList,ValueList,Tag) ->
  parse2(R,Context,Command,TagList,ValueList,Tag);
parse2([$=|R],Context,Command,TagList,ValueList,Tag) ->
  parse3(R,Context,Command,[list_to_atom(lists:reverse(Tag))|TagList],
	 ValueList);
parse2([C|R],Context,Command,TagList,ValueList,Tag) ->
  parse2(R,Context,Command,TagList,ValueList,[C|Tag]).

parse3([], _Context, _Command, _TagList, _ValueList) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse3([$-,$-,$>|_R], _Context, _Command, _TagList, _ValueList) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse3([$ |R], Context, Command, TagList, ValueList) ->
  parse3(R, Context, Command, TagList, ValueList);
parse3([$"|R], Context, Command, TagList, ValueList) ->
  parse4(R,Context,Command,TagList,ValueList,"");
parse3(_String, _Context, _Command, _TagList, _ValueList) ->
  throw({parse_error,"Premature EOF in parsed file"}).

parse4([], _Context, _Command, _TagList, _ValueList, _Value) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse4([$-,$-,$>|_R], _Context, _Command, _TagList, _ValueList, _Value) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse4([$"|R],Context,Command,TagList,ValueList,Value) ->
  parse2(R,Context,Command,TagList,[lists:reverse(Value)|ValueList],"");
parse4([C|R],Context,Command,TagList,ValueList,Value) ->
  parse4(R,Context,Command,TagList,ValueList,[C|Value]).

parse5([], _Comment, _Depth) ->
  throw({parse_error,"Premature EOF in parsed file"});
parse5([$<,$!,$-,$-|R],Comment,Depth) ->
  parse5(R,[$-,$-,$!,$<|Comment],Depth+1);
parse5([$-,$-,$>|R],Comment,0) ->
  {">--"++Comment++"--!<",R};
parse5([$-,$-,$>|R],Comment,Depth) ->
  parse5(R,[$>,$-,$-|Comment],Depth-1);
parse5([C|R],Comment,Depth) ->
  parse5(R,[C|Comment],Depth).


sz(B) when binary(B) -> {binary,size(B)};
sz(L) when list(L)   -> {list,length(L)};
sz(_)                -> undefined.

%% send_error - Handle failure to send the file
%%
send_error({open,Reason},Info,Path) -> 
    httpd_file:handle_error(Reason, "open", Info, Path);
send_error({read,Reason},Info,Path) -> 
    httpd_file:handle_error(Reason, "read", Info, Path).