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: httpd_response.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
18%%
19-module(httpd_response).
20-export([send/1, send_status/3, send_status/5]).
21
22%%code is the key for the statuscode ex: 200 404 ...
23-define(HTTP11HEADERFIELDS,[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]).
29
30-define(HTTP10HEADERFIELDS,[content_length, date, pragma, transfer_encoding,
31			    location, server, allow, content_encoding,
32			    content_type, last_modified]).
33
34-define(PROCEED_RESPONSE(StatusCode, Info),
35	{proceed,
36	 [{response,{already_sent, StatusCode,
37		     httpd_util:key1search(Info#mod.data,content_length)}}]}).
38
39
40-include("httpd.hrl").
41
42-define(VMODULE,"RESPONSE").
43-include("httpd_verbosity.hrl").
44
45%% send
46
47send(#mod{config_db = ConfigDB} = Info) ->
48    ?vtrace("send -> Request line: ~p", [Info#mod.request_line]),
49    Modules = httpd_util:lookup(ConfigDB,modules,[mod_get, mod_head, mod_log]),
50    case traverse_modules(Info, Modules) of
51	done ->
52	    Info;
53	{proceed, Data} ->
54	    case httpd_util:key1search(Data, status) of
55		{StatusCode, PhraseArgs, Reason} ->
56		    ?vdebug("send -> proceed/status: ~n"
57			    "~n   StatusCode: ~p"
58			    "~n   PhraseArgs: ~p"
59			    "~n   Reason:     ~p",
60			    [StatusCode, PhraseArgs, Reason]),
61		    send_status(Info, StatusCode, PhraseArgs),
62		    Info;
63
64		undefined ->
65		    case httpd_util:key1search(Data, response) of
66			{already_sent, StatusCode, Size} ->
67			    ?vtrace("send -> already sent: "
68				    "~n   StatusCode: ~p"
69				    "~n   Size:       ~p",
70				    [StatusCode, Size]),
71			    Info;
72			{response, Header, Body} -> %% New way
73			    send_response(Info, Header, Body),
74			    Info;
75			{StatusCode, Response} ->   %% Old way
76			    send_response_old(Info, StatusCode, Response),
77			    Info;
78			undefined ->
79			    ?vtrace("send -> undefined response", []),
80			    send_status(Info, 500, none),
81			    Info
82		    end
83	    end
84    end.
85
86
87%% traverse_modules
88
89traverse_modules(Info,[]) ->
90    {proceed,Info#mod.data};
91traverse_modules(Info,[Module|Rest]) ->
92    case (catch apply(Module,do,[Info])) of
93	{'EXIT', Reason} ->
94	    ?vlog("traverse_modules -> exit reason: ~p",[Reason]),
95	    String =
96		lists:flatten(
97		  io_lib:format("traverse exit from apply: ~p:do => ~n~p",
98				[Module, Reason])),
99	    report_error(mod_log, Info#mod.config_db, String),
100	    report_error(mod_disk_log, Info#mod.config_db, String),
101	    done;
102	done ->
103	    done;
104	{break,NewData} ->
105	    {proceed,NewData};
106	{proceed,NewData} ->
107	    traverse_modules(Info#mod{data=NewData},Rest)
108    end.
109
110%% send_status %%
111
112
113send_status(#mod{socket_type = SocketType,
114		 socket      = Socket,
115		 connection  = Conn} = Info, 100, _PhraseArgs) ->
116    ?DEBUG("send_status -> StatusCode: ~p~n",[100]),
117    Header = httpd_util:header(100, Conn),
118    httpd_socket:deliver(SocketType, Socket,
119			 [Header, "Content-Length:0\r\n\r\n"]);
120
121send_status(#mod{socket_type = SocketType,
122		 socket      = Socket,
123		 config_db   = ConfigDB} = Info, StatusCode, PhraseArgs) ->
124    send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB).
125
126send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB) ->
127    ?DEBUG("send_status -> ~n"
128	"    StatusCode: ~p~n"
129	"    PhraseArgs: ~p",
130	[StatusCode, PhraseArgs]),
131    Header       = httpd_util:header(StatusCode, "text/html", false),
132    ReasonPhrase = httpd_util:reason_phrase(StatusCode),
133    Message      = httpd_util:message(StatusCode, PhraseArgs, ConfigDB),
134    Body         = get_body(ReasonPhrase, Message),
135    Header1 =
136	Header ++
137	"Content-Length:" ++
138	integer_to_list(length(Body)) ++
139	"\r\n\r\n",
140    httpd_socket:deliver(SocketType, Socket, [Header1, Body]).
141
142
143get_body(ReasonPhrase, Message)->
144    "<HTML>
145       <HEAD>
146           <TITLE>"++ReasonPhrase++"</TITLE>
147      </HEAD>
148      <BODY>
149      <H1>"++ReasonPhrase++"</H1>\n"++Message++"\n</BODY>
150      </HTML>\n".
151
152
153%%% Create a response from the Key/Val tuples In the Head  List
154%%% Body is a tuple {body,Fun(),Args}
155
156%% send_response
157%% Allowed Fields
158
159% HTTP-Version StatusCode Reason-Phrase
160% *((general-headers
161%   response-headers
162%    entity-headers)CRLF)
163%  CRLF
164% ?(BODY)
165
166% General Header fields
167% ======================
168% Cache-Control cache_control
169% Connection %%Is set dependiong on the request
170% Date
171% Pramga
172% Trailer
173% Transfer-Encoding
174
175% Response Header field
176% =====================
177% Accept-Ranges
178% (Age) Mostly for proxys
179% Etag
180% Location
181% (Proxy-Authenticate) Only for proxies
182% Retry-After
183% Server
184% Vary
185% WWW-Authenticate
186%
187% Entity Header Fields
188% ====================
189% Allow
190% Content-Encoding
191% Content-Language
192% Content-Length
193% Content-Location
194% Content-MD5
195% Content-Range
196% Content-Type
197% Expires
198% Last-Modified
199
200
201send_response(Info, Header, Body) ->
202    ?vtrace("send_response -> (new) entry with"
203	    "~n   Header:       ~p", [Header]),
204    case httpd_util:key1search(Header, code) of
205	undefined ->
206	    %% No status code
207	    %% Ooops this must be very bad:
208	    %% generate a 404 content not availible
209	    send_status(Info, 404, "The file is not availible");
210	StatusCode ->
211	    case send_header(Info, StatusCode, Header) of
212		ok ->
213		    send_body(Info, StatusCode, Body);
214		Error ->
215		    ?vlog("head delivery failure: ~p", [Error]),
216		    done
217	    end
218    end.
219
220
221send_header(#mod{socket_type  = Type, socket     = Sock,
222		 http_version = Ver,  connection = Conn} = Info,
223	    StatusCode, Head0) ->
224    ?vtrace("send_haeder -> entry with"
225	    "~n   Ver:  ~p"
226	    "~n   Conn: ~p", [Ver, Conn]),
227    Head1 = create_header(Ver, Head0),
228    StatusLine = [Ver, " ",
229		  io_lib:write(StatusCode), " ",
230		  httpd_util:reason_phrase(StatusCode), "\r\n"],
231    Connection = get_connection(Conn, Ver),
232    Head = list_to_binary([StatusLine, Head1, Connection,"\r\n"]),
233    ?vtrace("deliver head", []),
234    httpd_socket:deliver(Type, Sock, Head).
235
236
237send_body(_, _, nobody) ->
238    ?vtrace("send_body -> no body", []),
239    ok;
240
241send_body(#mod{socket_type = Type, socket = Sock},
242	  StatusCode, Body) when list(Body) ->
243    ?vtrace("deliver body of size ~p", [length(Body)]),
244    httpd_socket:deliver(Type, Sock, Body);
245
246send_body(#mod{socket_type = Type, socket = Sock} = Info,
247	  StatusCode, {Fun, Args}) ->
248    case (catch apply(Fun, Args)) of
249	close ->
250	    httpd_socket:close(Type, Sock),
251	    done;
252
253	sent ->
254	    ?PROCEED_RESPONSE(StatusCode, Info);
255
256	{ok, Body} ->
257	    ?vtrace("deliver body", []),
258	    case httpd_socket:deliver(Type, Sock, Body) of
259		ok ->
260		    ?PROCEED_RESPONSE(StatusCode, Info);
261		Error ->
262		    ?vlog("body delivery failure: ~p", [Error]),
263		    done
264	    end;
265
266	Error ->
267	    ?vlog("failure of apply(~p,~p): ~p", [Fun, Args, Error]),
268	    done
269    end;
270send_body(I, S, B) ->
271    ?vinfo("BAD ARGS: "
272	   "~n   I: ~p"
273	   "~n   S: ~p"
274	   "~n   B: ~p", [I, S, B]),
275    exit({bad_args, {I, S, B}}).
276
277
278%% Return a HTTP-header field that indicates that the
279%% connection will be inpersistent
280get_connection(true,"HTTP/1.0")->
281    "Connection:close\r\n";
282get_connection(false,"HTTP/1.1") ->
283    "Connection:close\r\n";
284get_connection(_,_) ->
285    "".
286
287
288create_header("HTTP/1.1", Data) ->
289    create_header1(?HTTP11HEADERFIELDS, Data);
290create_header(_, Data) ->
291    create_header1(?HTTP10HEADERFIELDS, Data).
292
293create_header1(Fields, Data) ->
294    ?DEBUG("create_header() -> "
295	   "~n   Fields :~p~n   Data: ~p ~n", [Fields, Data]),
296    mapfilter(fun(Field)->
297		      transform({Field, httpd_util:key1search(Data, Field)})
298	      end, Fields, undefined).
299
300
301%% Do a map and removes the values that evaluates to RemoveVal
302mapfilter(Fun,List,RemoveVal)->
303    mapfilter(Fun,List,[],RemoveVal).
304
305mapfilter(Fun,[],[RemoveVal|Acc],RemoveVal)->
306    Acc;
307mapfilter(Fun,[],Acc,_RemoveVal)->
308    Acc;
309
310mapfilter(Fun,[Elem|Rest],[RemoveVal|Acc],RemoveVal)->
311    mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal);
312mapfilter(Fun,[Elem|Rest],Acc,RemoveVal)->
313    mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal).
314
315
316transform({content_type,undefined})->
317    ["Content-Type:text/plain\r\n"];
318
319transform({date,undefined})->
320    ["Date:",httpd_util:rfc1123_date(),"\r\n"];
321
322transform({date,RFCDate})->
323    ["Date:",RFCDate,"\r\n"];
324
325
326transform({_Key,undefined})->
327		 undefined;
328transform({accept_ranges,Value})->
329    ["Accept-Ranges:",Value,"\r\n"];
330transform({cache_control,Value})->
331    ["Cache-Control:",Value,"\r\n"];
332transform({pragma,Value})->
333    ["Pragma:",Value,"\r\n"];
334transform({trailer,Value})->
335    ["Trailer:",Value,"\r\n"];
336transform({transfer_encoding,Value})->
337    ["Pragma:",Value,"\r\n"];
338transform({etag,Value})->
339    ["ETag:",Value,"\r\n"];
340transform({location,Value})->
341    ["Retry-After:",Value,"\r\n"];
342transform({server,Value})->
343    ["Server:",Value,"\r\n"];
344transform({allow,Value})->
345    ["Allow:",Value,"\r\n"];
346transform({content_encoding,Value})->
347    ["Content-Encoding:",Value,"\r\n"];
348transform({content_language,Value})->
349    ["Content-Language:",Value,"\r\n"];
350transform({retry_after,Value})->
351    ["Retry-After:",Value,"\r\n"];
352transform({server,Value})->
353    ["Server:",Value,"\r\n"];
354transform({allow,Value})->
355    ["Allow:",Value,"\r\n"];
356transform({content_encoding,Value})->
357    ["Content-Encoding:",Value,"\r\n"];
358transform({content_language,Value})->
359    ["Content-Language:",Value,"\r\n"];
360transform({content_location,Value})->
361    ["Content-Location:",Value,"\r\n"];
362transform({content_length,Value})->
363    ["Content-Length:",Value,"\r\n"];
364transform({content_MD5,Value})->
365    ["Content-MD5:",Value,"\r\n"];
366transform({content_range,Value})->
367    ["Content-Range:",Value,"\r\n"];
368transform({content_type,Value})->
369    ["Content-Type:",Value,"\r\n"];
370transform({expires,Value})->
371    ["Expires:",Value,"\r\n"];
372transform({last_modified,Value})->
373    ["Last-Modified:",Value,"\r\n"].
374
375
376
377%%----------------------------------------------------------------------
378%% This is the old way of sending data it is strongly encouraged to
379%% Leave this method and go on to the newer form of response
380%% OTP-4408
381%%----------------------------------------------------------------------
382
383send_response_old(#mod{socket_type = Type,
384		       socket      = Sock,
385		       method      = "HEAD"} = Info,
386		  StatusCode, Response) ->
387    ?vtrace("send_response_old(HEAD) -> entry with"
388	    "~n   StatusCode: ~p"
389	    "~n   Response:   ~p",
390	    [StatusCode,Response]),
391    case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
392	{ok, [Head, Body]} ->
393	    Header =
394		httpd_util:header(StatusCode,Info#mod.connection) ++
395		"Content-Length:" ++ content_length(Body),
396	    httpd_socket:deliver(Type, Sock, [Header,Head,"\r\n"]);
397
398	Error ->
399	    send_status(Info, 500, "Internal Server Error")
400    end;
401
402send_response_old(#mod{socket_type = Type,
403		       socket      = Sock} = Info,
404		  StatusCode, Response) ->
405    ?vtrace("send_response_old -> entry with"
406	    "~n   StatusCode: ~p"
407	    "~n   Response:   ~p",
408	    [StatusCode,Response]),
409    case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
410	{ok, [_Head, Body]} ->
411	    Header =
412		httpd_util:header(StatusCode,Info#mod.connection) ++
413		"Content-Length:" ++ content_length(Body),
414	    httpd_socket:deliver(Type, Sock, [Header, Response]);
415
416	{ok, Body} ->
417	    Header =
418		httpd_util:header(StatusCode,Info#mod.connection) ++
419		"Content-Length:" ++ content_length(Body) ++ "\r\n",
420	    httpd_socket:deliver(Type, Sock, [Header, Response]);
421
422	{error, Reason} ->
423	    send_status(Info, 500, "Internal Server Error")
424    end.
425
426content_length(Body)->
427    integer_to_list(httpd_util:flatlength(Body))++"\r\n".
428
429
430report_error(Mod, ConfigDB, Error) ->
431    Modules = httpd_util:lookup(ConfigDB, modules,
432				[mod_get, mod_head, mod_log]),
433    case lists:member(Mod, Modules) of
434	true ->
435	    Mod:report_error(ConfigDB, Error);
436	_ ->
437	    ok
438    end.
439