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