← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_response.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

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