%% ``Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%%
%% $Id: httpd_response.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
%%
-module(httpd_response).
-export([send/1, send_status/3, send_status/5]).
%%code is the key for the statuscode ex: 200 404 ...
-define(HTTP11HEADERFIELDS,[content_length, accept_ranges, cache_control, date,
pragma, trailer, transfer_encoding, etag, location,
retry_after, server, allow,
content_encoding, content_language,
content_location, content_MD5, content_range,
content_type, expires, last_modified]).
-define(HTTP10HEADERFIELDS,[content_length, date, pragma, transfer_encoding,
location, server, allow, content_encoding,
content_type, last_modified]).
-define(PROCEED_RESPONSE(StatusCode, Info),
{proceed,
[{response,{already_sent, StatusCode,
httpd_util:key1search(Info#mod.data,content_lenght)}}]}).
-include("httpd.hrl").
-define(VMODULE,"RESPONSE").
-include("httpd_verbosity.hrl").
%% send
send(#mod{config_db = ConfigDB} = Info) ->
?vtrace("send -> Request line: ~p", [Info#mod.request_line]),
Modules = httpd_util:lookup(ConfigDB,modules,[mod_get, mod_head, mod_log]),
case traverse_modules(Info, Modules) of
done ->
Info;
{proceed, Data} ->
case httpd_util:key1search(Data, status) of
{StatusCode, PhraseArgs, Reason} ->
?vdebug("send -> proceed/status: ~n"
"~n StatusCode: ~p"
"~n PhraseArgs: ~p"
"~n Reason: ~p",
[StatusCode, PhraseArgs, Reason]),
send_status(Info, StatusCode, PhraseArgs),
Info;
undefined ->
case httpd_util:key1search(Data, response) of
{already_sent, StatusCode, Size} ->
?vtrace("send -> already sent: "
"~n StatusCode: ~p"
"~n Size: ~p",
[StatusCode, Size]),
Info;
{response, Header, Body} -> %% New way
send_response(Info, Header, Body),
Info;
{StatusCode, Response} -> %% Old way
send_response_old(Info, StatusCode, Response),
Info;
undefined ->
?vtrace("send -> undefined response", []),
send_status(Info, 500, none),
Info
end
end
end.
%% traverse_modules
traverse_modules(Info,[]) ->
{proceed,Info#mod.data};
traverse_modules(Info,[Module|Rest]) ->
case (catch apply(Module,do,[Info])) of
{'EXIT', Reason} ->
?vlog("traverse_modules -> exit reason: ~p",[Reason]),
String =
lists:flatten(
io_lib:format("traverse exit from apply: ~p:do => ~n~p",
[Module, Reason])),
report_error(mod_log, Info#mod.config_db, String),
report_error(mod_disk_log, Info#mod.config_db, String),
done;
done ->
done;
{break,NewData} ->
{proceed,NewData};
{proceed,NewData} ->
traverse_modules(Info#mod{data=NewData},Rest)
end.
%% send_status %%
send_status(#mod{socket_type = SocketType,
socket = Socket,
connection = Conn} = Info, 100, _PhraseArgs) ->
?DEBUG("send_status -> StatusCode: ~p~n",[100]),
Header = httpd_util:header(100, Conn),
httpd_socket:deliver(SocketType, Socket,
[Header, "Content-Length:0\r\n\r\n"]);
send_status(#mod{socket_type = SocketType,
socket = Socket,
config_db = ConfigDB} = Info, StatusCode, PhraseArgs) ->
send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB).
send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB) ->
?DEBUG("send_status -> ~n"
" StatusCode: ~p~n"
" PhraseArgs: ~p",
[StatusCode, PhraseArgs]),
Header = httpd_util:header(StatusCode, "text/html", false),
ReasonPhrase = httpd_util:reason_phrase(StatusCode),
Message = httpd_util:message(StatusCode, PhraseArgs, ConfigDB),
Body = get_body(ReasonPhrase, Message),
Header1 =
Header ++
"Content-Length:" ++
integer_to_list(length(Body)) ++
"\r\n\r\n",
httpd_socket:deliver(SocketType, Socket, [Header1, Body]).
get_body(ReasonPhrase, Message)->
"<HTML>
<HEAD>
<TITLE>"++ReasonPhrase++"</TITLE>
</HEAD>
<BODY>
<H1>"++ReasonPhrase++"</H1>\n"++Message++"\n</BODY>
</HTML>\n".
%%% Create a response from the Key/Val tuples In the Head List
%%% Body is a tuple {body,Fun(),Args}
%% send_response
%% Allowed Fields
% HTTP-Version StatusCode Reason-Phrase
% *((general-headers
% response-headers
% entity-headers)CRLF)
% CRLF
% ?(BODY)
% General Header fields
% ======================
% Cache-Control cache_control
% Connection %%Is set dependiong on the request
% Date
% Pramga
% Trailer
% Transfer-Encoding
% Response Header field
% =====================
% Accept-Ranges
% (Age) Mostly for proxys
% Etag
% Location
% (Proxy-Authenticate) Only for proxies
% Retry-After
% Server
% Vary
% WWW-Authenticate
%
% Entity Header Fields
% ====================
% Allow
% Content-Encoding
% Content-Language
% Content-Length
% Content-Location
% Content-MD5
% Content-Range
% Content-Type
% Expires
% Last-Modified
send_response(Info, Header, Body) ->
?vtrace("send_response -> (new) entry with"
"~n Header: ~p", [Header]),
case httpd_util:key1search(Header, code) of
undefined ->
%% No status code
%% Ooops this must be very bad:
%% generate a 404 content not availible
send_status(Info, 404, "The file is not availible");
StatusCode ->
case send_header(Info, StatusCode, Header) of
ok ->
send_body(Info, StatusCode, Body);
Error ->
?vlog("head delivery failure: ~p", [Error]),
done
end
end.
send_header(#mod{socket_type = Type, socket = Sock,
http_version = Ver, connection = Conn} = Info,
StatusCode, Head0) ->
?vtrace("send_haeder -> entry with"
"~n Ver: ~p"
"~n Conn: ~p", [Ver, Conn]),
Head1 = create_header(Ver, Head0),
StatusLine = [Ver, " ",
io_lib:write(StatusCode), " ",
httpd_util:reason_phrase(StatusCode), "\r\n"],
Connection = get_connection(Conn, Ver),
Head = list_to_binary([StatusLine, Head1, Connection,"\r\n"]),
?vtrace("deliver head", []),
httpd_socket:deliver(Type, Sock, Head).
send_body(_, _, nobody) ->
?vtrace("send_body -> no body", []),
ok;
send_body(#mod{socket_type = Type, socket = Sock},
StatusCode, Body) when list(Body) ->
?vtrace("deliver body of size ~p", [length(Body)]),
httpd_socket:deliver(Type, Sock, Body);
send_body(#mod{socket_type = Type, socket = Sock} = Info,
StatusCode, {Fun, Args}) ->
case (catch apply(Fun, Args)) of
close ->
httpd_socket:close(Type, Sock),
done;
sent ->
?PROCEED_RESPONSE(StatusCode, Info);
{ok, Body} ->
?vtrace("deliver body", []),
case httpd_socket:deliver(Type, Sock, Body) of
ok ->
?PROCEED_RESPONSE(StatusCode, Info);
Error ->
?vlog("body delivery failure: ~p", [Error]),
done
end;
Error ->
?vlog("failure of apply(~p,~p): ~p", [Fun, Args, Error]),
done
end;
send_body(I, S, B) ->
?vinfo("BAD ARGS: "
"~n I: ~p"
"~n S: ~p"
"~n B: ~p", [I, S, B]),
exit({bad_args, {I, S, B}}).
%% Return a HTTP-header field that indicates that the
%% connection will be inpersistent
get_connection(true,"HTTP/1.0")->
"Connection:close\r\n";
get_connection(false,"HTTP/1.1") ->
"Connection:close\r\n";
get_connection(_,_) ->
"".
create_header("HTTP/1.1", Data) ->
create_header1(?HTTP11HEADERFIELDS, Data);
create_header(_, Data) ->
create_header1(?HTTP10HEADERFIELDS, Data).
create_header1(Fields, Data) ->
?DEBUG("create_header() -> "
"~n Fields :~p~n Data: ~p ~n", [Fields, Data]),
mapfilter(fun(Field)->
transform({Field, httpd_util:key1search(Data, Field)})
end, Fields, undefined).
%% Do a map and removes the values that evaluates to RemoveVal
mapfilter(Fun,List,RemoveVal)->
mapfilter(Fun,List,[],RemoveVal).
mapfilter(Fun,[],[RemoveVal|Acc],RemoveVal)->
Acc;
mapfilter(Fun,[],Acc,_RemoveVal)->
Acc;
mapfilter(Fun,[Elem|Rest],[RemoveVal|Acc],RemoveVal)->
mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal);
mapfilter(Fun,[Elem|Rest],Acc,RemoveVal)->
mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal).
transform({content_type,undefined})->
["Content-Type:text/plain\r\n"];
transform({date,undefined})->
["Date:",httpd_util:rfc1123_date(),"\r\n"];
transform({date,RFCDate})->
["Date:",RFCDate,"\r\n"];
transform({_Key,undefined})->
undefined;
transform({accept_ranges,Value})->
["Accept-Ranges:",Value,"\r\n"];
transform({cache_control,Value})->
["Cache-Control:",Value,"\r\n"];
transform({pragma,Value})->
["Pragma:",Value,"\r\n"];
transform({trailer,Value})->
["Trailer:",Value,"\r\n"];
transform({transfer_encoding,Value})->
["Pragma:",Value,"\r\n"];
transform({etag,Value})->
["ETag:",Value,"\r\n"];
transform({location,Value})->
["Retry-After:",Value,"\r\n"];
transform({server,Value})->
["Server:",Value,"\r\n"];
transform({allow,Value})->
["Allow:",Value,"\r\n"];
transform({content_encoding,Value})->
["Content-Encoding:",Value,"\r\n"];
transform({content_language,Value})->
["Content-Language:",Value,"\r\n"];
transform({retry_after,Value})->
["Retry-After:",Value,"\r\n"];
transform({server,Value})->
["Server:",Value,"\r\n"];
transform({allow,Value})->
["Allow:",Value,"\r\n"];
transform({content_encoding,Value})->
["Content-Encoding:",Value,"\r\n"];
transform({content_language,Value})->
["Content-Language:",Value,"\r\n"];
transform({content_location,Value})->
["Content-Location:",Value,"\r\n"];
transform({content_length,Value})->
["Content-Length:",Value,"\r\n"];
transform({content_MD5,Value})->
["Content-MD5:",Value,"\r\n"];
transform({content_range,Value})->
["Content-Range:",Value,"\r\n"];
transform({content_type,Value})->
["Content-Type:",Value,"\r\n"];
transform({expires,Value})->
["Expires:",Value,"\r\n"];
transform({last_modified,Value})->
["Last-Modified:",Value,"\r\n"].
%%----------------------------------------------------------------------
%% This is the old way of sending data it is strongly encouraged to
%% Leave this method and go on to the newer form of response
%% OTP-4408
%%----------------------------------------------------------------------
send_response_old(#mod{socket_type = Type,
socket = Sock,
method = "HEAD"} = Info,
StatusCode, Response) ->
?vtrace("send_response_old(HEAD) -> entry with"
"~n StatusCode: ~p"
"~n Response: ~p",
[StatusCode,Response]),
case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
{ok, [Head, Body]} ->
Header =
httpd_util:header(StatusCode,Info#mod.connection) ++
"Content-Length:" ++ content_length(Body),
httpd_socket:deliver(Type, Sock, [Header,Head,"\r\n"]);
Error ->
send_status(Info, 500, "Internal Server Error")
end;
send_response_old(#mod{socket_type = Type,
socket = Sock} = Info,
StatusCode, Response) ->
?vtrace("send_response_old -> entry with"
"~n StatusCode: ~p"
"~n Response: ~p",
[StatusCode,Response]),
case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
{ok, [_Head, Body]} ->
Header =
httpd_util:header(StatusCode,Info#mod.connection) ++
"Content-Length:" ++ content_length(Body),
httpd_socket:deliver(Type, Sock, [Header, Response]);
{ok, Body} ->
Header =
httpd_util:header(StatusCode,Info#mod.connection) ++
"Content-Length:" ++ content_length(Body) ++ "\r\n",
httpd_socket:deliver(Type, Sock, [Header, Response]);
{error, Reason} ->
send_status(Info, 500, "Internal Server Error")
end.
content_length(Body)->
integer_to_list(httpd_util:flatlength(Body))++"\r\n".
report_error(Mod, ConfigDB, Error) ->
Modules = httpd_util:lookup(ConfigDB, modules,
[mod_get, mod_head, mod_log]),
case lists:member(Mod, Modules) of
true ->
Mod:report_error(ConfigDB, Error);
_ ->
ok
end.
