aboutsummaryrefslogtreecommitdiffstats
path: root/lib/inets/src/http_server/httpd_response.erl
diff options
context:
space:
mode:
authorErlang/OTP <otp@erlang.org>2009-11-20 14:54:40 +0000
committerErlang/OTP <otp@erlang.org>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/inets/src/http_server/httpd_response.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/inets/src/http_server/httpd_response.erl')
-rw-r--r--lib/inets/src/http_server/httpd_response.erl407
1 files changed, 407 insertions, 0 deletions
diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl
new file mode 100644
index 0000000000..ea9cfbf4f2
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_response.erl
@@ -0,0 +1,407 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_response).
+-export([generate_and_send_response/1, send_status/3, send_header/3,
+ send_body/3, send_chunk/3, send_final_chunk/2, split_header/2,
+ is_disable_chunked_send/1, cache_headers/1]).
+-export([map_status_code/2]).
+
+-include("httpd.hrl").
+-include("http_internal.hrl").
+-include("httpd_internal.hrl").
+
+-define(VMODULE,"RESPONSE").
+
+%% If peername does not exist the client already discarded the
+%% request so we do not need to send a reply.
+generate_and_send_response(#mod{init_data =
+ #init_data{peername = {_,"unknown"}}}) ->
+ ok;
+generate_and_send_response(#mod{config_db = ConfigDB} = ModData) ->
+ Modules = httpd_util:lookup(ConfigDB,modules,
+ [mod_get, mod_head, mod_log]),
+ case traverse_modules(ModData, Modules) of
+ done ->
+ ok;
+ {proceed, Data} ->
+ case proplists:get_value(status, Data) of
+ {StatusCode, PhraseArgs, _Reason} ->
+ send_status(ModData, StatusCode, PhraseArgs),
+ ok;
+ undefined ->
+ case proplists:get_value(response, Data) of
+ {already_sent, _StatusCode, _Size} ->
+ ok;
+ {response, Header, Body} -> %% New way
+ send_response(ModData, Header, Body),
+ ok;
+ {StatusCode, Response} -> %% Old way
+ send_response_old(ModData, StatusCode, Response),
+ ok;
+ undefined ->
+ send_status(ModData, 500, none),
+ ok
+ end
+ end
+ end.
+
+
+%% traverse_modules
+
+traverse_modules(ModData,[]) ->
+ {proceed,ModData#mod.data};
+traverse_modules(ModData,[Module|Rest]) ->
+ ?hdrd("traverse modules", [{callback_module, Module}]),
+ case (catch apply(Module, do, [ModData])) of
+ {'EXIT', Reason} ->
+ ?hdrd("traverse modules - exit", [{reason, Reason}]),
+ String =
+ lists:flatten(
+ io_lib:format("traverse exit from apply: ~p:do => ~n~p",
+ [Module, Reason])),
+ report_error(mod_log, ModData#mod.config_db, String),
+ report_error(mod_disk_log, ModData#mod.config_db, String),
+ done;
+ done ->
+ ?hdrt("traverse modules - done", []),
+ done;
+ {break, NewData} ->
+ ?hdrt("traverse modules - break", [{new_data, NewData}]),
+ {proceed, NewData};
+ {proceed, NewData} ->
+ ?hdrt("traverse modules - proceed", [{new_data, NewData}]),
+ traverse_modules(ModData#mod{data = NewData}, Rest)
+ end.
+
+%% send_status %%
+
+
+send_status(ModData, 100, _PhraseArgs) ->
+ send_header(ModData, 100, [{content_length, "0"}]);
+
+send_status(#mod{socket_type = SocketType,
+ socket = Socket,
+ config_db = ConfigDB} = ModData, StatusCode, PhraseArgs) ->
+
+ ReasonPhrase = httpd_util:reason_phrase(StatusCode),
+ Message = httpd_util:message(StatusCode, PhraseArgs, ConfigDB),
+ Body = get_body(ReasonPhrase, Message),
+
+ send_header(ModData, StatusCode, [{content_type, "text/html"},
+ {content_length, integer_to_list(length(Body))}]),
+ httpd_socket:deliver(SocketType, Socket, Body).
+
+
+get_body(ReasonPhrase, Message)->
+ "<HTML>
+ <HEAD>
+ <TITLE>"++ReasonPhrase++"</TITLE>
+ </HEAD>
+ <BODY>
+ <H1>"++ReasonPhrase++"</H1>\n"++Message++"\n</BODY>
+ </HTML>\n".
+
+
+send_response(ModData, Header, Body) ->
+ case proplists:get_value(code, Header) of
+ undefined ->
+ %% No status code
+ %% Ooops this must be very bad:
+ %% generate a 404 content not availible
+ send_status(ModData, 404, "The file is not availible");
+ StatusCode ->
+ case send_header(ModData, StatusCode, lists:keydelete(code, 1,
+ Header)) of
+ ok ->
+ send_body(ModData, StatusCode, Body);
+ _ ->
+ done
+ end
+ end.
+
+send_header(#mod{socket_type = Type, socket = Sock,
+ http_version = Ver, connection = Conn} = _ModData,
+ StatusCode, KeyValueTupleHeaders) ->
+ Headers = create_header(lists:map(fun transform/1, KeyValueTupleHeaders)),
+ NewVer = case {Ver, StatusCode} of
+ {[], _} ->
+ %% May be implicit!
+ "HTTP/0.9";
+ {unknown, 408} ->
+ %% This will proably never happen! It means the
+ %% server has timed out the request without
+ %% receiving a version for the request! Send the
+ %% lowest version so to ensure that the client
+ %% will be able to handle it, probably the
+ %% sensible thing to do!
+ "HTTP/0.9";
+ {undefined,_} ->
+ "HTTP/1.0"; %% See rfc2145 2.3 last paragraph
+ _ ->
+ Ver
+ end,
+ NewStatusCode = map_status_code(NewVer, StatusCode),
+ StatusLine = [NewVer, " ", io_lib:write(NewStatusCode), " ",
+ httpd_util:reason_phrase(NewStatusCode), ?CRLF],
+ ConnectionHeader = get_connection(Conn, NewVer),
+ Head = list_to_binary([StatusLine, Headers, ConnectionHeader , ?CRLF]),
+ httpd_socket:deliver(Type, Sock, Head).
+
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 2) andalso (Code > 204) ->
+ 403;
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 3) andalso (Code > 304) ->
+ 403;
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 4) andalso (Code > 404) ->
+ 403;
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 5) andalso (Code > 503) ->
+ 403;
+map_status_code(_, Code) ->
+ Code.
+
+send_body(#mod{socket_type = Type, socket = Socket}, _, nobody) ->
+ httpd_socket:close(Type, Socket),
+ ok;
+
+send_body(#mod{socket_type = Type, socket = Sock},
+ _StatusCode, Body) when is_list(Body) ->
+ case httpd_socket:deliver(Type, Sock, Body) of
+ socket_closed ->
+ done;
+ Else ->
+ Else
+ end;
+
+send_body(#mod{socket_type = Type, socket = Sock} = ModData,
+ StatusCode, {Fun, Args}) ->
+ case (catch apply(Fun, Args)) of
+ close ->
+ httpd_socket:close(Type, Sock),
+ done;
+
+ sent ->
+ {proceed,[{response,{already_sent, StatusCode,
+ proplists:get_value(content_length,
+ ModData#mod.data)}}]};
+ {ok, Body} ->
+ case httpd_socket:deliver(Type, Sock, Body) of
+ ok ->
+ {proceed,[{response,
+ {already_sent, StatusCode,
+ proplists:get_value(content_length,
+ ModData#mod.data)}}]};
+ _ ->
+ done
+ end;
+
+ _ ->
+ done
+ end.
+
+split_header([$: | Value], AccName) ->
+ Name = http_util:to_lower(string:strip(AccName)),
+ {lists:reverse(Name),
+ string:strip(string:strip(string:strip(Value, right, ?LF), right, ?CR))};
+split_header([Char | Rest], AccName) ->
+ split_header(Rest, [Char | AccName]).
+
+send_chunk(_, <<>>, _) ->
+ ok;
+send_chunk(_, [], _) ->
+ ok;
+
+send_chunk(#mod{http_version = "HTTP/1.1",
+ socket_type = Type, socket = Sock}, Response0, false) ->
+ Response = http_chunk:encode(Response0),
+ httpd_socket:deliver(Type, Sock, Response);
+
+send_chunk(#mod{socket_type = Type, socket = Sock} = _ModData, Response, _) ->
+ httpd_socket:deliver(Type, Sock, Response).
+
+send_final_chunk(#mod{http_version = "HTTP/1.1",
+ socket_type = Type, socket = Sock}, false) ->
+ httpd_socket:deliver(Type, Sock, http_chunk:encode_last());
+send_final_chunk(#mod{socket_type = Type, socket = Sock}, _) ->
+ httpd_socket:close(Type, Sock).
+
+is_disable_chunked_send(Db) ->
+ httpd_util:lookup(Db, disable_chunked_transfer_encoding_send, false).
+
+%% 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(_,_) ->
+ "".
+
+cache_headers(#mod{config_db = Db}) ->
+ case httpd_util:lookup(Db, script_nocache, false) of
+ true ->
+ Date = httpd_util:rfc1123_date(),
+ [{"cache-control", "no-cache"},
+ {"pragma", "no-cache"},
+ {"expires", Date}];
+ false ->
+ []
+ end.
+
+create_header(KeyValueTupleHeaders) ->
+ NewHeaders = add_default_headers([{"date", httpd_util:rfc1123_date()},
+ {"content-type", "text/html"},
+ {"server", ?SERVER_SOFTWARE}],
+ KeyValueTupleHeaders),
+ lists:map(fun fix_header/1, NewHeaders).
+
+fix_header({Key0, Value}) ->
+ %% make sure first letter is capital
+ Words1 = string:tokens(Key0, "-"),
+ Words2 = upify(Words1, []),
+ Key = new_key(Words2),
+ Key ++ ": " ++ Value ++ ?CRLF .
+
+new_key([]) ->
+ "";
+new_key([W]) ->
+ W;
+new_key([W1,W2]) ->
+ W1 ++ "-" ++ W2;
+new_key([W|R]) ->
+ W ++ "-" ++ new_key(R).
+
+upify([], Acc) ->
+ lists:reverse(Acc);
+upify([Key|Rest], Acc) ->
+ upify(Rest, [upify2(Key)|Acc]).
+
+upify2([C|Rest]) when (C >= $a) andalso (C =< $z) ->
+ [C-($a-$A)|Rest];
+upify2(Str) ->
+ Str.
+
+add_default_headers([], Headers) ->
+ Headers;
+
+add_default_headers([Header = {Default, _} | Defaults], Headers) ->
+ case lists:keysearch(Default, 1, Headers) of
+ {value, _} ->
+ add_default_headers(Defaults, Headers);
+ _ ->
+ add_default_headers(Defaults, [Header | Headers])
+ end.
+
+transform({content_type, Value}) ->
+ {"content-type", Value};
+transform({accept_ranges, Value}) ->
+ {"accept-ranges", Value};
+transform({cache_control, Value}) ->
+ {"cache-control",Value};
+transform({transfer_encoding, Value}) ->
+ {"transfer-encoding", Value};
+transform({content_encoding, Value}) ->
+ {"content-encoding", Value};
+transform({content_language, Value}) ->
+ {"content-language", Value};
+transform({retry_after, Value}) ->
+ {"retry-after", Value};
+transform({content_location, Value}) ->
+ {"Content-Location:", Value};
+transform({content_length, Value}) ->
+ {"content-length", Value};
+transform({content_MD5, Value}) ->
+ {"content-md5", Value};
+transform({content_range, Value}) ->
+ {"content-range", Value};
+transform({last_modified, Value}) ->
+ {"last-modified", Value};
+transform({Field, Value}) when is_atom(Field) ->
+ {atom_to_list(Field), Value};
+transform({Field, Value}) when is_list(Field) ->
+ {Field, Value}.
+
+%%----------------------------------------------------------------------
+%% 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{method = "HEAD"} = ModData,
+ StatusCode, Response) ->
+ NewResponse = lists:flatten(Response),
+
+ case httpd_util:split(NewResponse, [?CR, ?LF, ?CR, ?LF],2) of
+ {ok, [Head, Body]} ->
+ {ok, NewHead} = handle_headers(string:tokens(Head, [?CR,?LF]), []),
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(Body)} | NewHead]);
+ {ok, [NewResponse]} ->
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(NewResponse)}]);
+ _Error ->
+ send_status(ModData, 500, "Internal Server Error")
+ end;
+
+send_response_old(#mod{socket_type = Type,
+ socket = Sock} = ModData,
+ StatusCode, Response) ->
+
+ NewResponse = lists:flatten(Response),
+
+ case httpd_util:split(NewResponse, [?CR, ?LF, ?CR, ?LF], 2) of
+ {ok, [Head, Body]} ->
+ {ok, NewHead} = handle_headers(string:tokens(Head,
+ [?CR,?LF]), []),
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(Body)} |
+ NewHead]),
+ httpd_socket:deliver(Type, Sock, Body);
+ {ok, [NewResponse]} ->
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(NewResponse)}]),
+ httpd_socket:deliver(Type, Sock, NewResponse);
+
+ {error, _Reason} ->
+ send_status(ModData, 500, "Internal Server Error")
+ end.
+
+content_length(Body)->
+ integer_to_list(httpd_util:flatlength(Body)).
+
+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.
+
+handle_headers([], NewHeaders) ->
+ {ok, NewHeaders};
+
+handle_headers([Header | Headers], NewHeaders) ->
+ {FieldName, FieldValue} = split_header(Header, []),
+ handle_headers(Headers,
+ [{FieldName, FieldValue}| NewHeaders]).
+