1
%% ``The contents of this file are subject to the Erlang Public License,
2
%% Version 1.1, (the "License"); you may not use this file except in
3
%% compliance with the License. You should have received a copy of the
4
%% Erlang Public License along with this software. If not, it can be
5
%% retrieved via the world wide web at http://www.erlang.org/.
7
%% Software distributed under the License is distributed on an "AS IS"
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
9
%% the License for the specific language governing rights and limitations
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
14
%% AB. All Rights Reserved.''
18
-module(httpd_response).
19
-export([send/1, send_status/3, send_status/5]).
21
%%code is the key for the statuscode ex: 200 404 ...
22
-define(HTTP_11_HEADER_FIELDS,
23
[content_length, accept_ranges, cache_control, date,
24
pragma, trailer, transfer_encoding, etag, location,
25
retry_after, server, allow,
26
content_encoding, content_language,
27
content_location, content_MD5, content_range,
28
content_type, expires, last_modified]).
30
-define(HTTP_10_HEADER_FIELDS,
31
[content_length, date,
35
content_type, last_modified]).
37
-define(PROCEED_RESPONSE(StatusCode, Info),
39
[{response,{already_sent, StatusCode,
40
httpd_util:key1search(Info#mod.data,content_length)}}]}).
43
-include("httpd.hrl").
45
-define(VMODULE,"RESPONSE").
46
-include("httpd_verbosity.hrl").
50
send(#mod{config_db = ConfigDB} = Info) ->
51
?vtrace("send -> Request line: ~p", [Info#mod.request_line]),
52
Modules = httpd_util:lookup(ConfigDB,modules,[mod_get, mod_head, mod_log]),
53
case traverse_modules(Info, Modules) of
57
case httpd_util:key1search(Data, status) of
58
{StatusCode, PhraseArgs, Reason} ->
59
?vdebug("send -> proceed/status: ~n"
63
[StatusCode, PhraseArgs, Reason]),
64
send_status(Info, StatusCode, PhraseArgs),
68
case httpd_util:key1search(Data, response) of
69
{already_sent, StatusCode, Size} ->
70
?vtrace("send -> already sent: "
75
{response, Header, Body} -> %% New way
76
send_response(Info, Header, Body),
78
{StatusCode, Response} -> %% Old way
79
send_response_old(Info, StatusCode, Response),
82
?vtrace("send -> undefined response", []),
83
send_status(Info, 500, none),
92
traverse_modules(Info,[]) ->
93
{proceed,Info#mod.data};
94
traverse_modules(Info,[Module|Rest]) ->
95
case (catch apply(Module,do,[Info])) of
97
?vlog("traverse_modules -> exit reason: ~p",[Reason]),
100
io_lib:format("traverse exit from apply: ~p:do => ~n~p",
102
report_error(mod_log, Info#mod.config_db, String),
103
report_error(mod_disk_log, Info#mod.config_db, String),
110
traverse_modules(Info#mod{data=NewData},Rest)
116
send_status(#mod{socket_type = SocketType,
118
connection = Conn} = _Info, 100, _PhraseArgs) ->
119
Header = httpd_util:header(100, Conn),
120
httpd_socket:deliver(SocketType, Socket,
121
[Header, "Content-Length:0\r\n\r\n"]);
123
send_status(#mod{socket_type = SocketType,
125
config_db = ConfigDB} = _Info, StatusCode, PhraseArgs) ->
126
send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB).
128
send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB) ->
129
Header = httpd_util:header(StatusCode, "text/html", false),
130
ReasonPhrase = httpd_util:reason_phrase(StatusCode),
131
Message = httpd_util:message(StatusCode, PhraseArgs, ConfigDB),
132
Body = get_body(ReasonPhrase, Message),
136
integer_to_list(length(Body)) ++
138
httpd_socket:deliver(SocketType, Socket, [Header1, Body]).
141
get_body(ReasonPhrase, Message)->
144
<TITLE>"++ReasonPhrase++"</TITLE>
147
<H1>"++ReasonPhrase++"</H1>\n"++Message++"\n</BODY>
151
%%% Create a response from the Key/Val tuples In the Head List
152
%%% Body is a tuple {body,Fun(),Args}
157
% HTTP-Version StatusCode Reason-Phrase
160
% entity-headers)CRLF)
164
% General Header fields
165
% ======================
166
% Cache-Control cache_control
167
% Connection %%Is set dependiong on the request
173
% Response Header field
174
% =====================
176
% (Age) Mostly for proxys
179
% (Proxy-Authenticate) Only for proxies
185
% Entity Header Fields
186
% ====================
199
send_response(Info, Header, Body) ->
200
?vtrace("send_response -> (new) entry with"
201
"~n Header: ~p", [Header]),
202
case httpd_util:key1search(Header, code) of
205
%% Ooops this must be very bad:
206
%% generate a 404 content not availible
207
send_status(Info, 404, "The file is not availible");
209
case send_header(Info, StatusCode, Header) of
211
send_body(Info, StatusCode, Body);
213
?vlog("head delivery failure: ~p", [Error]),
219
send_header(#mod{config_db = Db,
220
socket_type = Type, socket = Sock,
221
http_version = Ver, connection = Conn} = _Info,
222
StatusCode, Head0) ->
223
?vtrace("send_header -> entry with"
225
"~n Conn: ~p", [Ver, Conn]),
226
Head1 = create_header(Db, Ver, Head0),
227
StatusLine = [Ver, " ",
228
io_lib:write(StatusCode), " ",
229
httpd_util:reason_phrase(StatusCode), "\r\n"],
230
Connection = get_connection(Conn, Ver),
231
Head = list_to_binary([StatusLine, Head1, Connection,"\r\n"]),
232
?vtrace("deliver head", []),
233
httpd_socket:deliver(Type, Sock, Head).
236
send_body(_, _, nobody) ->
237
?vtrace("send_body -> no body", []),
240
send_body(#mod{socket_type = Type, socket = Sock},
241
_StatusCode, Body) when list(Body) ->
242
?vtrace("deliver body of size ~p", [length(Body)]),
243
httpd_socket:deliver(Type, Sock, Body);
245
send_body(#mod{socket_type = Type, socket = Sock} = Info,
246
StatusCode, {Fun, Args}) ->
247
case (catch apply(Fun, Args)) of
249
httpd_socket:close(Type, Sock),
253
?PROCEED_RESPONSE(StatusCode, Info);
256
?vtrace("deliver body", []),
257
case httpd_socket:deliver(Type, Sock, Body) of
259
?PROCEED_RESPONSE(StatusCode, Info);
261
?vlog("body delivery failure: ~p", [Error]),
266
?vlog("failure of apply(~p,~p): ~p", [Fun, Args, Error]),
269
send_body(I, S, B) ->
273
"~n B: ~p", [I, S, B]),
274
exit({bad_args, {I, S, B}}).
277
%% Return a HTTP-header field that indicates that the
278
%% connection will be inpersistent
279
get_connection(true,"HTTP/1.0")->
280
"Connection:close\r\n";
281
get_connection(false,"HTTP/1.1") ->
282
"Connection:close\r\n";
283
get_connection(_,_) ->
287
disable_chunked_send(Db) ->
288
httpd_util:lookup(Db, disable_chunked_transfer_encoding_send, false).
290
create_header(Db, "HTTP/1.1", Data) ->
291
DisableChunkedSend = disable_chunked_send(Db),
292
Disable = [{transfer_encoding, DisableChunkedSend}],
293
create_header1(?HTTP_11_HEADER_FIELDS, Data, Disable);
294
create_header(_, _, Data) ->
295
create_header1(?HTTP_10_HEADER_FIELDS, Data, []).
297
create_header1(Fields, Data, Disable) ->
301
httpd_util:key1search(Data, Field),
304
mapfilter(Fun, Fields, undefined).
307
%% Do a map and removes the values that evaluates to RemoveVal
308
mapfilter(Fun, List, RemoveVal) ->
309
mapfilter(Fun,List,[],RemoveVal).
311
mapfilter(_Fun,[],[RemoveVal|Acc],RemoveVal) ->
313
mapfilter(_Fun,[],Acc,_RemoveVal) ->
316
mapfilter(Fun, [Elem|Rest], [RemoveVal| Acc], RemoveVal) ->
317
mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal);
318
mapfilter(Fun,[Elem|Rest],Acc,RemoveVal)->
319
mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal).
322
transform(content_type, undefined, _Disable) ->
323
["Content-Type:text/plain\r\n"];
325
transform(date, undefined, _Disable) ->
326
["Date:",httpd_util:rfc1123_date(),"\r\n"];
328
transform(date,RFCDate, _Disable) ->
329
["Date:",RFCDate,"\r\n"];
332
transform(_Key, undefined, _Disable) ->
334
transform(accept_ranges, Value, _Disable) ->
335
["Accept-Ranges:",Value,"\r\n"];
336
transform(cache_control, Value, _Disable) ->
337
["Cache-Control:",Value,"\r\n"];
338
transform(pragma, Value, _Disable) ->
339
["Pragma:",Value,"\r\n"];
340
transform(trailer, Value, _Disable) ->
341
["Trailer:",Value,"\r\n"];
342
transform(transfer_encoding, Value, Disable) ->
343
case httpd_util:key1search(Disable,
344
disable_chunked_transfer_encoding_send) of
348
["Transfer-encoding:",Value,"\r\n"]
350
transform(etag, Value, _Disable) ->
351
["ETag:",Value,"\r\n"];
352
transform(location, Value, _Disable) ->
353
["Retry-After:",Value,"\r\n"];
354
transform(server, Value, _Disable) ->
355
["Server:",Value,"\r\n"];
356
transform(allow, Value, _Disable) ->
357
["Allow:",Value,"\r\n"];
358
transform(content_encoding, Value, _Disable) ->
359
["Content-Encoding:",Value,"\r\n"];
360
transform(content_language, Value, _Disable) ->
361
["Content-Language:",Value,"\r\n"];
362
transform(retry_after, Value, _Disable) ->
363
["Retry-After:",Value,"\r\n"];
364
transform(server, Value, _Disable) ->
365
["Server:",Value,"\r\n"];
366
transform(allow, Value, _Disable) ->
367
["Allow:",Value,"\r\n"];
368
transform(content_encoding, Value, _Disable) ->
369
["Content-Encoding:",Value,"\r\n"];
370
transform(content_language, Value, _Disable) ->
371
["Content-Language:",Value,"\r\n"];
372
transform(content_location, Value, _Disable) ->
373
["Content-Location:",Value,"\r\n"];
374
transform(content_length, Value, _Disable) ->
375
["Content-Length:",Value,"\r\n"];
376
transform(content_MD5, Value, _Disable) ->
377
["Content-MD5:",Value,"\r\n"];
378
transform(content_range, Value, _Disable) ->
379
["Content-Range:",Value,"\r\n"];
380
transform(content_type, Value, _Disable) ->
381
["Content-Type:",Value,"\r\n"];
382
transform(expires, Value, _Disable) ->
383
["Expires:",Value,"\r\n"];
384
transform(last_modified, Value, _Disable) ->
385
["Last-Modified:",Value,"\r\n"].
389
%%----------------------------------------------------------------------
390
%% This is the old way of sending data it is strongly encouraged to
391
%% Leave this method and go on to the newer form of response
393
%%----------------------------------------------------------------------
395
send_response_old(#mod{socket_type = Type,
397
method = "HEAD"} = Info,
398
StatusCode, Response) ->
399
?vtrace("send_response_old(HEAD) -> entry with"
402
[StatusCode,Response]),
403
case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
404
{ok, [Head, Body]} ->
406
httpd_util:header(StatusCode,Info#mod.connection) ++
407
"Content-Length:" ++ content_length(Body),
408
httpd_socket:deliver(Type, Sock, [Header,Head,"\r\n"]);
411
send_status(Info, 500, "Internal Server Error")
414
send_response_old(#mod{socket_type = Type,
415
socket = Sock} = Info,
416
StatusCode, Response) ->
417
?vtrace("send_response_old -> entry with"
420
[StatusCode,Response]),
421
case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
422
{ok, [_Head, Body]} ->
424
httpd_util:header(StatusCode,Info#mod.connection) ++
425
"Content-Length:" ++ content_length(Body),
426
httpd_socket:deliver(Type, Sock, [Header, Response]);
430
httpd_util:header(StatusCode,Info#mod.connection) ++
431
"Content-Length:" ++ content_length(Body) ++ "\r\n",
432
httpd_socket:deliver(Type, Sock, [Header, Response]);
435
send_status(Info, 500, "Internal Server Error")
438
content_length(Body)->
439
integer_to_list(httpd_util:flatlength(Body))++"\r\n".
442
report_error(Mod, ConfigDB, Error) ->
443
Modules = httpd_util:lookup(ConfigDB, modules,
444
[mod_get, mod_head, mod_log]),
445
case lists:member(Mod, Modules) of
447
Mod:report_error(ConfigDB, Error);
added
removed
lib/inets/src/httpd_response.erl
