← Back to branch summary

~clint-fewbar/ubuntu/precise/erlang/merge-15b

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl

  • Committer: Package Import Robot
  • Author(s): Sergei Golovan
  • Date: 2011-12-15 19:20:10 UTC
  • mfrom: (1.1.18) (3.5.15 sid)
  • mto: (3.5.16 sid)
  • mto: This revision was merged to the branch mainline in revision 33.
  • Revision ID: package-import@ubuntu.com-20111215192010-jnxcfe3tbrpp0big
Tags: 1:15.b-dfsg-1
* New upstream release.
* Upload to experimental because this release breaks external drivers
  API along with ABI, so several applications are to be fixed.
* Removed SSL patch because the old SSL implementation is removed from
  the upstream distribution.
* Removed never used patch which added native code to erlang beam files.
* Removed the erlang-docbuilder binary package because the docbuilder
  application was dropped by upstream.
* Documented dropping ${erlang-docbuilder:Depends} substvar in
  erlang-depends(1) manpage.
* Made erlang-base and erlang-base-hipe provide virtual package
  erlang-abi-15.b (the number means the first erlang version, which
  provides current ABI).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.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: mod_cgi.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
 
17
%%
 
18
-module(mod_cgi).
 
19
-export([do/1,env/3,status_code/1,load/2]).
 
20
 
 
21
%%Exports to the interface for sending chunked data
 
22
%% to http/1.1 users and full responses to http/1.0
 
23
-export([send/5,final_send/4, update_status_code/2,get_new_size/2]).
 
24
-include("httpd.hrl").
 
25
 
 
26
-define(VMODULE,"CGI").
 
27
-include("httpd_verbosity.hrl").
 
28
 
 
29
-define(GATEWAY_INTERFACE,"CGI/1.1").
 
30
-define(DEFAULT_CGI_TIMEOUT,15000).
 
31
 
 
32
%% do
 
33
 
 
34
do(Info) ->
 
35
    ?vtrace("do",[]),
 
36
    case httpd_util:key1search(Info#mod.data,status) of
 
37
        %% A status code has been generated!
 
38
        {StatusCode, PhraseArgs, Reason} ->
 
39
            {proceed, Info#mod.data};
 
40
        %% No status code has been generated!
 
41
        undefined ->
 
42
            ?vtrace("do -> no status code has been generated", []),
 
43
            case httpd_util:key1search(Info#mod.data,response) of
 
44
                %% No response has been generated!
 
45
                undefined ->
 
46
                    ?vtrace("do -> no response has been generated", []),
 
47
                    RequestURI =
 
48
                        case httpd_util:key1search(Info#mod.data,
 
49
                                                   new_request_uri) of
 
50
                            undefined ->
 
51
                                Info#mod.request_uri;
 
52
                            Value ->
 
53
                                Value
 
54
                        end,
 
55
                    ?vtrace("do -> RequestURI: ~p", [RequestURI]),
 
56
                    ScriptAliases =
 
57
                        httpd_util:multi_lookup(Info#mod.config_db,
 
58
                                                script_alias),
 
59
                    ?vtrace("do -> ScriptAliases: ~p", [ScriptAliases]),
 
60
                    case mod_alias:real_script_name(Info#mod.config_db,
 
61
                                                    RequestURI,
 
62
                                                    ScriptAliases) of
 
63
                        {Script, AfterScript} ->
 
64
                            exec_script(Info, Script, AfterScript, RequestURI);
 
65
                        not_a_script ->
 
66
                            {proceed,Info#mod.data}
 
67
                    end;
 
68
                %% A response has been generated or sent!
 
69
                Response ->
 
70
                    {proceed,Info#mod.data}
 
71
            end
 
72
    end.
 
73
 
 
74
 
 
75
%% is_executable(File) ->
 
76
%%    ?DEBUG("is_executable -> entry with~n"
 
77
%%         "   File: ~s",[File]),
 
78
%%    Dir      = filename:dirname(File),
 
79
%%    FileName = filename:basename(File),
 
80
%%    is_executable(FileName,Dir).
 
81
%%
 
82
%% is_executable(FileName,Dir) ->
 
83
%%    ?DEBUG("is_executable -> entry with~n"
 
84
%%         "   Dir:      ~s~n"
 
85
%%         "   FileName: ~s",[Dir,FileName]),
 
86
%%    case os:find_executable(FileName, Dir) of
 
87
%%      false ->
 
88
%%          false;
 
89
%%      _ ->
 
90
%%          true
 
91
%%    end.
 
92
 
 
93
 
 
94
%% -------------------------
 
95
%% Start temporary (hopefully) fix for win32
 
96
%% OTP-3627
 
97
%%
 
98
 
 
99
is_executable(File) ->
 
100
    Dir      = filename:dirname(File),
 
101
    FileName = filename:basename(File),
 
102
    case os:type() of
 
103
        {win32,_} ->
 
104
            is_win32_executable(Dir,FileName);
 
105
        _ ->
 
106
            is_other_executable(Dir,FileName)
 
107
    end.
 
108
 
 
109
 
 
110
is_win32_executable(D,F) ->
 
111
    case ends_with(F,[".bat",".exe",".com"]) of
 
112
        false ->
 
113
            %% This is why we cant use 'os:find_executable' directly.
 
114
            %% It assumes that executable files is given without extension
 
115
            case os:find_executable(F,D) of
 
116
                false ->
 
117
                    false;
 
118
                _ ->
 
119
                    true
 
120
            end;
 
121
        true ->
 
122
            case file:read_file_info(D ++ "/" ++ F) of
 
123
                {ok,_} ->
 
124
                    true;
 
125
                _ ->
 
126
                    false
 
127
            end
 
128
    end.
 
129
 
 
130
 
 
131
is_other_executable(D,F) ->
 
132
    case os:find_executable(F,D) of
 
133
        false ->
 
134
            false;
 
135
        _ ->
 
136
            true
 
137
    end.
 
138
 
 
139
 
 
140
ends_with(File,[]) ->
 
141
    false;
 
142
ends_with(File,[Ext|Rest]) ->
 
143
    case ends_with1(File,Ext) of
 
144
        true ->
 
145
            true;
 
146
        false ->
 
147
            ends_with(File,Rest)
 
148
    end.
 
149
 
 
150
ends_with1(S,E) when length(S) >= length(E) ->
 
151
    case to_lower(string:right(S,length(E))) of
 
152
        E ->
 
153
            true;
 
154
        _ ->
 
155
            false
 
156
    end;
 
157
ends_with1(_S,_E) ->
 
158
    false.
 
159
 
 
160
 
 
161
to_lower(S)       -> to_lower(S,[]).
 
162
 
 
163
to_lower([],L)    -> lists:reverse(L);
 
164
to_lower([H|T],L) -> to_lower(T,[to_lower1(H)|L]).
 
165
 
 
166
to_lower1(C) when C >= $A, C =< $Z ->
 
167
    C + ($a - $A);
 
168
to_lower1(C) ->
 
169
    C.
 
170
 
 
171
%%
 
172
%% End fix
 
173
%% ---------------------------------
 
174
 
 
175
 
 
176
env(VarName, Value) ->
 
177
    {VarName, Value}.
 
178
 
 
179
env(Info, Script, AfterScript) ->
 
180
    ?vtrace("env -> entry with"
 
181
            "~n   Script:      ~p"
 
182
            "~n   AfterScript: ~p",
 
183
            [Script, AfterScript]),
 
184
    {_, RemoteAddr} = (Info#mod.init_data)#init_data.peername,
 
185
    ServerName = (Info#mod.init_data)#init_data.resolve,
 
186
    PH = parsed_header(Info#mod.parsed_header),
 
187
    Env =
 
188
        [env("SERVER_SOFTWARE",?SERVER_SOFTWARE),
 
189
         env("SERVER_NAME",ServerName),
 
190
         env("GATEWAY_INTERFACE",?GATEWAY_INTERFACE),
 
191
         env("SERVER_PROTOCOL",?SERVER_PROTOCOL),
 
192
         env("SERVER_PORT",
 
193
             integer_to_list(httpd_util:lookup(Info#mod.config_db,port,80))),
 
194
         env("REQUEST_METHOD",Info#mod.method),
 
195
         env("REMOTE_ADDR",RemoteAddr),
 
196
         env("SCRIPT_NAME",Script)],
 
197
    Env1 =
 
198
        case Info#mod.method of
 
199
            "GET" ->
 
200
                case AfterScript of
 
201
                    {[], QueryString} ->
 
202
                        [env("QUERY_STRING", QueryString)|Env];
 
203
                    {PathInfo, []} ->
 
204
                        Aliases = httpd_util:multi_lookup(
 
205
                                    Info#mod.config_db,alias),
 
206
                        {_, PathTranslated, _} =
 
207
                            mod_alias:real_name(
 
208
                              Info#mod.config_db, PathInfo, Aliases),
 
209
                        [Env|
 
210
                         [env("PATH_INFO","/"++httpd_util:decode_hex(PathInfo)),
 
211
                          env("PATH_TRANSLATED",PathTranslated)]];
 
212
                    {PathInfo, QueryString} ->
 
213
                        Aliases = httpd_util:multi_lookup(
 
214
                                    Info#mod.config_db,alias),
 
215
                        {_, PathTranslated, _} =
 
216
                            mod_alias:real_name(
 
217
                              Info#mod.config_db, PathInfo, Aliases),
 
218
                        [Env|
 
219
                         [env("PATH_INFO",
 
220
                              httpd_util:decode_hex(PathInfo)),
 
221
                          env("PATH_TRANSLATED",PathTranslated),
 
222
                          env("QUERY_STRING", QueryString)]];
 
223
                    [] ->
 
224
                        Env
 
225
                end;
 
226
            "POST" ->
 
227
                [env("CONTENT_LENGTH",
 
228
                     integer_to_list(httpd_util:flatlength(
 
229
                                       Info#mod.entity_body)))|Env];
 
230
            _ ->
 
231
                Env
 
232
        end,
 
233
    Env2 =
 
234
        case httpd_util:key1search(Info#mod.data,remote_user) of
 
235
            undefined ->
 
236
                Env1;
 
237
            RemoteUser ->
 
238
                [env("REMOTE_USER",RemoteUser)|Env1] %% OTP-4416
 
239
        end,
 
240
    lists:flatten([Env2|PH]).
 
241
 
 
242
 
 
243
parsed_header(List) ->
 
244
    parsed_header(List, []).
 
245
 
 
246
parsed_header([], SoFar) ->
 
247
    SoFar;
 
248
parsed_header([{Name,[Value|R1]}|R2], SoFar) when list(Value)->
 
249
    NewName=lists:map(fun(X) -> if X == $- -> $_; true -> X end end,Name),
 
250
    Env = env("HTTP_"++httpd_util:to_upper(NewName),
 
251
              multi_value([Value|R1])),
 
252
    parsed_header(R2, [Env|SoFar]);
 
253
 
 
254
parsed_header([{Name,Value}|Rest], SoFar) ->
 
255
    {ok,NewName,_} = regexp:gsub(Name, "-", "_"),
 
256
    Env=env("HTTP_"++httpd_util:to_upper(NewName),Value),
 
257
    parsed_header(Rest, [Env|SoFar]).
 
258
 
 
259
 
 
260
multi_value([]) ->
 
261
  [];
 
262
multi_value([Value]) ->
 
263
  Value;
 
264
multi_value([Value|Rest]) ->
 
265
  Value++", "++multi_value(Rest).
 
266
 
 
267
 
 
268
exec_script(Info, Script, AfterScript, RequestURI) ->
 
269
    ?vdebug("exec_script -> entry with"
 
270
            "~n   Script:      ~p"
 
271
            "~n   AfterScript: ~p",
 
272
            [Script,AfterScript]),
 
273
    exec_script(is_executable(Script),Info,Script,AfterScript,RequestURI).
 
274
 
 
275
exec_script(true, Info, Script, AfterScript, RequestURI) ->
 
276
    ?vtrace("exec_script -> entry when script is executable",[]),
 
277
    process_flag(trap_exit,true),
 
278
    Dir  = filename:dirname(Script),
 
279
    [Script_Name|_] = string:tokens(RequestURI, "?"),
 
280
    Env  = env(Info, Script_Name, AfterScript),
 
281
    Port = (catch open_port({spawn,Script},[stream,{cd, Dir},{env, Env}])),
 
282
    ?vtrace("exec_script -> Port: ~w",[Port]),
 
283
    case Port of
 
284
        P when port(P) ->
 
285
            %% Send entity_body to port.
 
286
            Res = case Info#mod.entity_body of
 
287
                      [] ->
 
288
                          true;
 
289
                      EntityBody ->
 
290
                          (catch port_command(Port, EntityBody))
 
291
                  end,
 
292
            case Res of
 
293
                {'EXIT',Reason} ->
 
294
                    ?vlog("port send failed:"
 
295
                          "~n   Port:   ~p"
 
296
                          "~n   URI:    ~p"
 
297
                          "~n   Reason: ~p",
 
298
                          [Port,Info#mod.request_uri,Reason]),
 
299
                    exit({open_cmd_failed,Reason,
 
300
                          [{mod,?MODULE},{port,Port},
 
301
                           {uri,Info#mod.request_uri},
 
302
                           {script,Script},{env,Env},{dir,Dir},
 
303
                           {ebody_size,sz(Info#mod.entity_body)}]});
 
304
                 true ->
 
305
                    proxy(Info, Port)
 
306
            end;
 
307
        {'EXIT',Reason} ->
 
308
            ?vlog("open port failed: exit"
 
309
                  "~n   URI:    ~p"
 
310
                  "~n   Reason: ~p",
 
311
                  [Info#mod.request_uri,Reason]),
 
312
            exit({open_port_failed,Reason,
 
313
                  [{mod,?MODULE},{uri,Info#mod.request_uri},{script,Script},
 
314
                   {env,Env},{dir,Dir}]});
 
315
        O ->
 
316
            ?vlog("open port failed: unknown result"
 
317
                  "~n   URI: ~p"
 
318
                  "~n   O:   ~p",
 
319
                  [Info#mod.request_uri,O]),
 
320
            exit({open_port_failed,O,
 
321
                  [{mod,?MODULE},{uri,Info#mod.request_uri},{script,Script},
 
322
                   {env,Env},{dir,Dir}]})
 
323
    end;
 
324
 
 
325
exec_script(false,Info,Script,_AfterScript,_RequestURI) ->
 
326
    ?vlog("script ~s not executable",[Script]),
 
327
    {proceed,
 
328
     [{status,
 
329
       {404,Info#mod.request_uri,
 
330
        ?NICE("You don't have permission to execute " ++
 
331
              Info#mod.request_uri ++ " on this server")}}|
 
332
      Info#mod.data]}.
 
333
 
 
334
 
 
335
 
 
336
%%
 
337
%% Socket <-> Port communication
 
338
%%
 
339
 
 
340
proxy(#mod{config_db = ConfigDb} = Info, Port) ->
 
341
    Timeout = httpd_util:lookup(ConfigDb, cgi_timeout, ?DEFAULT_CGI_TIMEOUT),
 
342
    proxy(Info, Port, 0, undefined,[], Timeout).
 
343
 
 
344
proxy(Info, Port, Size, StatusCode, AccResponse, Timeout) ->
 
345
    ?vdebug("proxy -> entry with"
 
346
            "~n   Size:      ~p"
 
347
            "~n   StatusCode ~p"
 
348
            "~n   Timeout:   ~p",
 
349
            [Size, StatusCode, Timeout]),
 
350
    receive
 
351
        {Port, {data, Response}} when port(Port) ->
 
352
            ?vtrace("proxy -> got some data from the port",[]),
 
353
 
 
354
            NewStatusCode = update_status_code(StatusCode, Response),
 
355
 
 
356
            ?vtrace("proxy -> NewStatusCode: ~p",[NewStatusCode]),
 
357
            case send(Info, NewStatusCode, Response, Size, AccResponse) of
 
358
                socket_closed ->
 
359
                    ?vtrace("proxy -> socket closed: kill port",[]),
 
360
                    (catch port_close(Port)), % KILL the port !!!!
 
361
                    process_flag(trap_exit,false),
 
362
                    {proceed,
 
363
                     [{response,{already_sent,200,Size}}|Info#mod.data]};
 
364
 
 
365
                head_sent ->
 
366
                    ?vtrace("proxy -> head sent: kill port",[]),
 
367
                    (catch port_close(Port)), % KILL the port !!!!
 
368
                    process_flag(trap_exit,false),
 
369
                    {proceed,
 
370
                     [{response,{already_sent,200,Size}}|Info#mod.data]};
 
371
 
 
372
                {http_response, NewAccResponse} ->
 
373
                    ?vtrace("proxy -> head response: continue",[]),
 
374
                    NewSize = get_new_size(Size, Response),
 
375
                    proxy(Info, Port, NewSize, NewStatusCode,
 
376
                          NewAccResponse, Timeout);
 
377
 
 
378
                _ ->
 
379
                    ?vtrace("proxy -> continue",[]),
 
380
                    %% The data is sent and the socket is not closed, continue
 
381
                    NewSize = get_new_size(Size, Response),
 
382
                    proxy(Info, Port, NewSize, NewStatusCode,
 
383
                          "nonempty", Timeout)
 
384
            end;
 
385
 
 
386
        {'EXIT', Port, normal} when port(Port) ->
 
387
            ?vtrace("proxy -> exit signal from port: normal",[]),
 
388
            NewStatusCode = update_status_code(StatusCode,AccResponse),
 
389
            final_send(Info,NewStatusCode,Size,AccResponse),
 
390
            process_flag(trap_exit,false),
 
391
            {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]};
 
392
 
 
393
        {'EXIT', Port, Reason} when port(Port) ->
 
394
            ?vtrace("proxy -> exit signal from port: ~p",[Reason]),
 
395
            process_flag(trap_exit, false),
 
396
            {proceed, [{status,{400,none,reason(Reason)}}|Info#mod.data]};
 
397
 
 
398
        {'EXIT', Pid, Reason} when pid(Pid) ->
 
399
            %% This is the case that a linked process has died,
 
400
            %% It would be nice to response with a server error
 
401
            %% but since the heade alredy is sent
 
402
            ?vtrace("proxy -> exit signal from ~p: ~p",[Pid, Reason]),
 
403
            proxy(Info, Port, Size, StatusCode, AccResponse, Timeout);
 
404
 
 
405
        %% This should not happen
 
406
        WhatEver ->
 
407
            ?vinfo("proxy -> received garbage: ~n~p", [WhatEver]),
 
408
            NewStatusCode = update_status_code(StatusCode, AccResponse),
 
409
            final_send(Info, StatusCode, Size, AccResponse),
 
410
            process_flag(trap_exit, false),
 
411
            {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]}
 
412
 
 
413
    after Timeout ->
 
414
            ?vlog("proxy -> timeout",[]),
 
415
            (catch port_close(Port)), % KILL the port !!!!
 
416
            httpd_socket:close(Info#mod.socket_type, Info#mod.socket),
 
417
            process_flag(trap_exit,false),
 
418
            {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]}
 
419
    end.
 
420
 
 
421
 
 
422
 
 
423
 
 
424
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
425
%%                                                                    %%
 
426
%% The functions that handles the sending of the data to the client   %%
 
427
%%                                                                    %%
 
428
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
429
 
 
430
%%----------------------------------------------------------------------
 
431
%% Send the header the first time the size of the body is Zero
 
432
%%----------------------------------------------------------------------
 
433
 
 
434
send(#mod{method = "HEAD"} = Info, StatusCode, Response, 0, []) ->
 
435
    first_handle_head_request(Info, StatusCode, Response);
 
436
send(Info, StatusCode, Response, 0, []) ->
 
437
    first_handle_other_request(Info, StatusCode, Response);
 
438
 
 
439
%%----------------------------------------------------------------------
 
440
%% The size of the body is bigger than zero =>
 
441
%% we have a part of the body to send
 
442
%%----------------------------------------------------------------------
 
443
send(Info, StatusCode, Response, Size, AccResponse) ->
 
444
    handle_other_request(Info, StatusCode, Response).
 
445
 
 
446
 
 
447
%%----------------------------------------------------------------------
 
448
%% The function is called the last time when the port has closed
 
449
%%----------------------------------------------------------------------
 
450
 
 
451
final_send(Info, StatusCode, Size, AccResponse)->
 
452
    final_handle_other_request(Info, StatusCode).
 
453
 
 
454
 
 
455
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
456
%%                                                                    %%
 
457
%% The code that handles the head requests                            %%
 
458
%%                                                                    %%
 
459
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
460
%%----------------------------------------------------------------------
 
461
%% The request is a head request if its a HTPT/1.1 request answer to it
 
462
%% otherwise we must collect the size of hte body before we can answer.
 
463
%% Return Values:
 
464
%% head_sent
 
465
%%----------------------------------------------------------------------
 
466
first_handle_head_request(Info, StatusCode, Response)->
 
467
    case Info#mod.http_version of
 
468
        "HTTP/1.1" ->
 
469
            %% Since we have all we need to create the header create it
 
470
            %% send it and return head_sent.
 
471
            case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
 
472
                {ok, [HeadEnd, Rest]} ->
 
473
                    HeadEnd1 = removeStatus(HeadEnd),
 
474
                    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,
 
475
                                         [create_header(Info,StatusCode),
 
476
                                          HeadEnd1,"\r\n\r\n"]);
 
477
                _ ->
 
478
                    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,
 
479
                                         [create_header(Info, StatusCode),
 
480
                                          "Content-Type:text/html\r\n\r\n"])
 
481
            end;
 
482
        _ ->
 
483
          Response1= case regexp:split(Response,"\r\n\r\n|\n\n") of
 
484
                          {ok,[HeadEnd|Rest]} ->
 
485
                             removeStatus(HeadEnd);
 
486
                          _ ->
 
487
                             ["Content-Type:text/html"]
 
488
                     end,
 
489
            H1 = httpd_util:header(StatusCode,Info#mod.connection),
 
490
            httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,
 
491
                                 [H1,Response1,"\r\n\r\n"])
 
492
    end,
 
493
    head_sent.
 
494
 
 
495
 
 
496
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
497
%%                                                                    %%
 
498
%% Handle the requests that is to the other methods                   %%
 
499
%%                                                                    %%
 
500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
501
%%----------------------------------------------------------------------
 
502
%% Create the http-response header and send it to the user if it is
 
503
%% a http/1.1 request otherwise we must accumulate it
 
504
%%----------------------------------------------------------------------
 
505
first_handle_other_request(Info,StatusCode,Response)->
 
506
    Header = create_header(Info,StatusCode),
 
507
    Response1 =
 
508
        case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
 
509
            {ok,[HeadPart,[]]} ->
 
510
                [Header, removeStatus(HeadPart),"\r\n\r\n"];
 
511
 
 
512
            {ok,[HeadPart,BodyPart]} ->
 
513
                      [Header, removeStatus(HeadPart), "\r\n\r\n",
 
514
                       httpd_util:integer_to_hexlist(length(BodyPart)),
 
515
                       "\r\n", BodyPart];
 
516
            _WhatEver ->
 
517
                %% No response header field from the cgi-script,
 
518
                %% Just a body
 
519
                [Header, "Content-Type:text/html","\r\n\r\n",
 
520
                 httpd_util:integer_to_hexlist(length(Response)),
 
521
                 "\r\n", Response]
 
522
        end,
 
523
    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket, Response1).
 
524
 
 
525
 
 
526
handle_other_request(#mod{http_version = "HTTP/1.1",
 
527
                          socket_type = Type, socket = Sock} = Info,
 
528
                     StatusCode, Response0) ->
 
529
    Response = create_chunk(Info, Response0),
 
530
    httpd_socket:deliver(Type, Sock, Response);
 
531
handle_other_request(#mod{socket_type = Type, socket = Sock} = Info,
 
532
                     StatusCode, Response) ->
 
533
    httpd_socket:deliver(Type, Sock, Response).
 
534
 
 
535
 
 
536
final_handle_other_request(#mod{http_version = "HTTP/1.1",
 
537
                                socket_type = Type, socket = Sock},
 
538
                           StatusCode) ->
 
539
    httpd_socket:deliver(Type, Sock, "0\r\n");
 
540
final_handle_other_request(#mod{socket_type = Type, socket = Sock},
 
541
                           StatusCode) ->
 
542
    httpd_socket:close(Type, Sock),
 
543
    socket_closed.
 
544
 
 
545
 
 
546
create_chunk(_Info, Response) ->
 
547
    HEXSize = httpd_util:integer_to_hexlist(length(lists:flatten(Response))),
 
548
    HEXSize++"\r\n"++Response++"\r\n".
 
549
 
 
550
 
 
551
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
552
%%                                                                    %%
 
553
%% The various helper functions                                       %%
 
554
%%                                                                    %%
 
555
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
556
 
 
557
update_status_code(undefined, Response) ->
 
558
    case status_code(Response) of
 
559
        {ok, StatusCode1} ->
 
560
            StatusCode1;
 
561
        _ ->
 
562
            ?vlog("invalid response from script:~n~p", [Response]),
 
563
            500
 
564
    end;
 
565
update_status_code(StatusCode,_Response)->
 
566
    StatusCode.
 
567
 
 
568
 
 
569
get_new_size(0,Response)->
 
570
    case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
 
571
        {ok,[Head,Body]}->
 
572
            length(lists:flatten(Body));
 
573
        _ ->
 
574
            %%No header in the respone
 
575
            length(lists:flatten(Response))
 
576
    end;
 
577
 
 
578
get_new_size(Size,Response)->
 
579
    Size+length(lists:flatten(Response)).
 
580
 
 
581
%%----------------------------------------------------------------------
 
582
%% Creates the http-header for a response
 
583
%%----------------------------------------------------------------------
 
584
create_header(Info,StatusCode)->
 
585
    Cache=case httpd_util:lookup(Info#mod.config_db,script_nocache,false) of
 
586
              true->
 
587
                  Date=httpd_util:rfc1123_date(),
 
588
                  "Cache-Control:no-cache\r\nPragma:no-cache\r\nExpires:"++ Date ++ "\r\n";
 
589
              false ->
 
590
                  []
 
591
          end,
 
592
    case Info#mod.http_version of
 
593
        "HTTP/1.1"  ->
 
594
            Header=httpd_util:header(StatusCode, Info#mod.connection),
 
595
            Header++"Transfer-encoding:chunked\r\n"++Cache;
 
596
        _ ->
 
597
            httpd_util:header(StatusCode,Info#mod.connection)++Cache
 
598
    end.
 
599
 
 
600
 
 
601
 
 
602
%% status_code
 
603
 
 
604
status_code(Response) ->
 
605
  case httpd_util:split(Response,"\n\n|\r\n\r\n",2) of
 
606
    {ok,[Header,Body]} ->
 
607
      case regexp:split(Header,"\n|\r\n") of
 
608
        {ok,HeaderFields} ->
 
609
          {ok,extract_status_code(HeaderFields)};
 
610
        {error,_} ->
 
611
              {error, bad_script_output(Response)}
 
612
      end;
 
613
    _ ->
 
614
          %% No header field in the returned data return 200 the standard code
 
615
          {ok, 200}
 
616
  end.
 
617
 
 
618
bad_script_output(Bad) ->
 
619
    lists:flatten(io_lib:format("Bad script output ~s",[Bad])).
 
620
 
 
621
 
 
622
extract_status_code([]) ->
 
623
  200;
 
624
extract_status_code([[$L,$o,$c,$a,$t,$i,$o,$n,$:,$ |_]|_]) ->
 
625
  302;
 
626
extract_status_code([[$S,$t,$a,$t,$u,$s,$:,$ |CodeAndReason]|_]) ->
 
627
  case httpd_util:split(CodeAndReason," ",2) of
 
628
    {ok,[Code,_]} ->
 
629
      list_to_integer(Code);
 
630
    {ok,_} ->
 
631
      200
 
632
  end;
 
633
extract_status_code([_|Rest]) ->
 
634
  extract_status_code(Rest).
 
635
 
 
636
 
 
637
sz(B) when binary(B) -> {binary,size(B)};
 
638
sz(L) when list(L)   -> {list,length(L)};
 
639
sz(_)                -> undefined.
 
640
 
 
641
 
 
642
%% Convert error to printable string
 
643
%%
 
644
reason({error,emfile})     -> ": To many open files";
 
645
reason({error,{enfile,_}}) -> ": File/port table overflow";
 
646
reason({error,enomem})     -> ": Not enough memory";
 
647
reason({error,eagain})     -> ": No more available OS processes";
 
648
reason(_)                  -> "".
 
649
 
 
650
removeStatus(Head)->
 
651
    case httpd_util:split(Head,"Status:.\r\n",2) of
 
652
        {ok,[HeadPart,HeadEnd]}->
 
653
            HeadPart++HeadEnd;
 
654
        _ ->
 
655
            Head
 
656
    end.
 
657
 
 
658
 
 
659
 
 
660
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
661
%%                                                                    %%
 
662
%% There are 2 config directives for mod_cgi:                         %%
 
663
%% ScriptNoCache true|false, defines whether the server shall add     %%
 
664
%%                           header fields to stop proxies and        %%
 
665
%%                           clients from saving the page in history  %%
 
666
%%                           or cache                                 %%
 
667
%%                                                                    %%
 
668
%% ScriptTimeout Seconds, The number of seconds that the server       %%
 
669
%%                        maximum will wait for the script to         %%
 
670
%%                        generate a part of the document             %%
 
671
%%                                                                    %%
 
672
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
673
 
 
674
load([$S,$c,$r,$i,$p,$t,$N,$o,$C,$a,$c,$h,$e |CacheArg],[])->
 
675
    case catch list_to_atom(httpd_conf:clean(CacheArg)) of
 
676
        true ->
 
677
            {ok, [], {script_nocache,true}};
 
678
        false ->
 
679
           {ok, [], {script_nocache,false}};
 
680
        _ ->
 
681
           {error, ?NICE(httpd_conf:clean(CacheArg)++
 
682
                         " is an invalid ScriptNoCache directive")}
 
683
    end;
 
684
 
 
685
load([$S,$c,$r,$i,$p,$t,$T,$i,$m,$e,$o,$u,$t,$ |Timeout],[])->
 
686
    case catch list_to_integer(httpd_conf:clean(Timeout)) of
 
687
        TimeoutSec when integer(TimeoutSec)  ->
 
688
           {ok, [], {script_timeout,TimeoutSec*1000}};
 
689
        _ ->
 
690
           {error, ?NICE(httpd_conf:clean(Timeout)++
 
691
                         " is an invalid ScriptTimeout")}
 
692
    end.