Test suites for Dialyzer

This is a transcription of most of the cvs.srv.it.uu.se:/hipe repository
dialyzer_tests into test suites that use the test server framework.

See README for information on how to use the included scripts for
modifications and updates.

When testing Dialyzer it's important that several OTP modules
are included in the plt. The suites takes care of that too.

1 files changed, 694 insertions, 0 deletions

diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_cgi.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_cgi.erl
new file mode 100644
index 0000000000..d9070b8860
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_cgi.erl
@@ -0,0 +1,694 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id: mod_cgi.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_cgi).
+-export([do/1,env/3,status_code/1,load/2]).
+
+%%Exports to the interface for sending chunked data 
+%% to http/1.1 users and full responses to http/1.0
+-export([send/5,final_send/4, update_status_code/2,get_new_size/2]).
+-include("httpd.hrl").
+
+-define(VMODULE,"CGI").
+-include("httpd_verbosity.hrl").
+
+-define(GATEWAY_INTERFACE,"CGI/1.1").
+-define(DEFAULT_CGI_TIMEOUT,15000).
+
+%% do
+
+do(Info) ->
+    ?vtrace("do",[]),
+    case httpd_util:key1search(Info#mod.data,status) of
+	%% A status code has been generated!
+	{StatusCode, PhraseArgs, Reason} ->
+	    {proceed, Info#mod.data};
+	%% No status code has been generated!
+	undefined ->
+	    ?vtrace("do -> no status code has been generated", []),
+	    case httpd_util:key1search(Info#mod.data,response) of
+		%% No response has been generated!
+		undefined ->
+		    ?vtrace("do -> no response has been generated", []),
+		    RequestURI =
+			case httpd_util:key1search(Info#mod.data,
+						   new_request_uri) of
+			    undefined ->
+				Info#mod.request_uri;
+			    Value ->
+				Value
+			end,
+		    ?vtrace("do -> RequestURI: ~p", [RequestURI]),
+		    ScriptAliases =
+			httpd_util:multi_lookup(Info#mod.config_db,
+						script_alias),
+		    ?vtrace("do -> ScriptAliases: ~p", [ScriptAliases]),
+		    case mod_alias:real_script_name(Info#mod.config_db,
+						    RequestURI,
+						    ScriptAliases) of
+			{Script, AfterScript} ->
+			    exec_script(Info, Script, AfterScript, RequestURI);
+			not_a_script ->
+			    {proceed,Info#mod.data}
+		    end;
+		%% A response has been generated or sent!
+		Response ->
+		    {proceed,Info#mod.data}
+	    end
+    end.
+
+
+%% is_executable(File) ->
+%%    ?DEBUG("is_executable -> entry with~n"
+%%	   "   File: ~s",[File]),
+%%    Dir      = filename:dirname(File),
+%%    FileName = filename:basename(File),
+%%    is_executable(FileName,Dir).
+%%
+%% is_executable(FileName,Dir) ->
+%%    ?DEBUG("is_executable -> entry with~n"
+%%	   "   Dir:      ~s~n"
+%%	   "   FileName: ~s",[Dir,FileName]),
+%%    case os:find_executable(FileName, Dir) of
+%%	false ->
+%%	    false;
+%%	_ ->
+%%	    true
+%%    end.
+
+
+%% -------------------------
+%% Start temporary (hopefully) fix for win32
+%% OTP-3627
+%%
+
+is_executable(File) ->
+    Dir      = filename:dirname(File),
+    FileName = filename:basename(File),
+    case os:type() of
+	{win32,_} ->
+	    is_win32_executable(Dir,FileName);
+	_ ->
+	    is_other_executable(Dir,FileName) 
+    end.
+
+
+is_win32_executable(D,F) ->
+    case ends_with(F,[".bat",".exe",".com"]) of
+	false ->
+	    %% This is why we cant use 'os:find_executable' directly.
+	    %% It assumes that executable files is given without extension
+	    case os:find_executable(F,D) of
+		false ->
+		    false;
+		_ ->
+		    true
+	    end;
+	true ->
+	    case file:read_file_info(D ++ "/" ++ F) of
+		{ok,_} ->
+		    true;
+		_ ->
+		    false
+	    end
+    end.
+	    
+
+is_other_executable(D,F) ->
+    case os:find_executable(F,D) of
+	false ->
+	    false;
+	_ ->
+	    true
+    end.
+
+
+ends_with(File,[]) ->
+    false;
+ends_with(File,[Ext|Rest]) ->
+    case ends_with1(File,Ext) of
+	true ->
+	    true;
+	false ->
+	    ends_with(File,Rest)
+    end.
+    
+ends_with1(S,E) when length(S) >= length(E) ->
+    case to_lower(string:right(S,length(E))) of
+	E ->
+	    true;
+	_ ->
+	    false
+    end;
+ends_with1(_S,_E) ->
+    false.
+    
+
+to_lower(S)       -> to_lower(S,[]).
+
+to_lower([],L)    -> lists:reverse(L);
+to_lower([H|T],L) -> to_lower(T,[to_lower1(H)|L]).
+
+to_lower1(C) when C >= $A, C =< $Z ->
+    C + ($a - $A);
+to_lower1(C) ->
+    C.
+
+%%
+%% End fix
+%% ---------------------------------
+    
+
+env(VarName, Value) ->
+    {VarName, Value}.
+
+env(Info, Script, AfterScript) ->
+    ?vtrace("env -> entry with"
+	    "~n   Script:      ~p"
+	    "~n   AfterScript: ~p",
+	    [Script, AfterScript]),
+    {_, RemoteAddr} = (Info#mod.init_data)#init_data.peername,
+    ServerName = (Info#mod.init_data)#init_data.resolve,
+    PH = parsed_header(Info#mod.parsed_header),
+    Env =
+	[env("SERVER_SOFTWARE",?SERVER_SOFTWARE),
+	 env("SERVER_NAME",ServerName),
+	 env("GATEWAY_INTERFACE",?GATEWAY_INTERFACE),
+	 env("SERVER_PROTOCOL",?SERVER_PROTOCOL),
+	 env("SERVER_PORT", 
+	     integer_to_list(httpd_util:lookup(Info#mod.config_db,port,80))),
+	 env("REQUEST_METHOD",Info#mod.method),
+	 env("REMOTE_ADDR",RemoteAddr),
+	 env("SCRIPT_NAME",Script)],
+    Env1 =
+        case Info#mod.method of
+            "GET" ->
+                case AfterScript of
+		    {[], QueryString} ->
+                        [env("QUERY_STRING", QueryString)|Env];
+		    {PathInfo, []} ->
+                        Aliases = httpd_util:multi_lookup(
+				    Info#mod.config_db,alias),
+                        {_, PathTranslated, _} =
+                            mod_alias:real_name(
+                              Info#mod.config_db, PathInfo, Aliases),
+                        [Env|
+                         [env("PATH_INFO","/"++httpd_util:decode_hex(PathInfo)),
+                          env("PATH_TRANSLATED",PathTranslated)]];
+		    {PathInfo, QueryString} ->
+                        Aliases = httpd_util:multi_lookup(
+				    Info#mod.config_db,alias),
+                        {_, PathTranslated, _} =
+                            mod_alias:real_name(
+                              Info#mod.config_db, PathInfo, Aliases),
+                        [Env|
+                         [env("PATH_INFO",
+			      httpd_util:decode_hex(PathInfo)),
+                          env("PATH_TRANSLATED",PathTranslated),
+			  env("QUERY_STRING", QueryString)]];
+		    [] ->
+			Env
+                end;
+            "POST" ->
+                [env("CONTENT_LENGTH",
+                     integer_to_list(httpd_util:flatlength(
+                                       Info#mod.entity_body)))|Env];
+            _ ->
+                Env
+        end,
+    Env2 =
+        case httpd_util:key1search(Info#mod.data,remote_user) of
+            undefined ->
+                Env1;
+            RemoteUser ->
+                [env("REMOTE_USER",RemoteUser)|Env1] %% OTP-4416
+        end,
+    lists:flatten([Env2|PH]).
+
+
+parsed_header(List) ->
+    parsed_header(List, []).
+ 
+parsed_header([], SoFar) ->
+    SoFar;
+parsed_header([{Name,[Value|R1]}|R2], SoFar) when list(Value)->
+    NewName=lists:map(fun(X) -> if X == $- -> $_; true -> X end end,Name),
+    Env = env("HTTP_"++httpd_util:to_upper(NewName),
+	      multi_value([Value|R1])),
+    parsed_header(R2, [Env|SoFar]);
+ 
+parsed_header([{Name,Value}|Rest], SoFar) ->
+    {ok,NewName,_} = regexp:gsub(Name, "-", "_"),
+    Env=env("HTTP_"++httpd_util:to_upper(NewName),Value),
+    parsed_header(Rest, [Env|SoFar]).
+ 
+
+multi_value([]) ->
+  [];
+multi_value([Value]) ->
+  Value;
+multi_value([Value|Rest]) ->
+  Value++", "++multi_value(Rest).
+
+
+exec_script(Info, Script, AfterScript, RequestURI) ->
+    ?vdebug("exec_script -> entry with"
+	    "~n   Script:      ~p"
+	    "~n   AfterScript: ~p",
+	    [Script,AfterScript]),
+    exec_script(is_executable(Script),Info,Script,AfterScript,RequestURI).
+
+exec_script(true, Info, Script, AfterScript, RequestURI) ->
+    ?vtrace("exec_script -> entry when script is executable",[]),
+    process_flag(trap_exit,true),
+    Dir  = filename:dirname(Script),
+    [Script_Name|_] = string:tokens(RequestURI, "?"),
+    Env  = env(Info, Script_Name, AfterScript),
+    Port = (catch open_port({spawn,Script},[stream,{cd, Dir},{env, Env}])),
+    ?vtrace("exec_script -> Port: ~w",[Port]),
+    case Port of
+	P when port(P) ->
+	    %% Send entity_body to port.
+	    Res = case Info#mod.entity_body of
+		      [] ->
+			  true;
+		      EntityBody ->
+			  (catch port_command(Port, EntityBody))
+		  end,
+	    case Res of
+		{'EXIT',Reason} ->
+		    ?vlog("port send failed:"
+			  "~n   Port:   ~p"
+			  "~n   URI:    ~p"
+			  "~n   Reason: ~p",
+			  [Port,Info#mod.request_uri,Reason]),
+		    exit({open_cmd_failed,Reason,
+			  [{mod,?MODULE},{port,Port},
+			   {uri,Info#mod.request_uri},
+			   {script,Script},{env,Env},{dir,Dir},
+			   {ebody_size,sz(Info#mod.entity_body)}]});
+		 true ->
+		    proxy(Info, Port)
+	    end;
+	{'EXIT',Reason} ->
+	    ?vlog("open port failed: exit"
+		  "~n   URI:    ~p"
+		  "~n   Reason: ~p",
+		  [Info#mod.request_uri,Reason]),
+	    exit({open_port_failed,Reason,
+		  [{mod,?MODULE},{uri,Info#mod.request_uri},{script,Script},
+		   {env,Env},{dir,Dir}]});
+	O ->
+	    ?vlog("open port failed: unknown result"
+		  "~n   URI: ~p"
+		  "~n   O:   ~p",
+		  [Info#mod.request_uri,O]),
+	    exit({open_port_failed,O,
+		  [{mod,?MODULE},{uri,Info#mod.request_uri},{script,Script},
+		   {env,Env},{dir,Dir}]})
+    end;
+
+exec_script(false,Info,Script,_AfterScript,_RequestURI) ->
+    ?vlog("script ~s not executable",[Script]),
+    {proceed,
+     [{status,
+       {404,Info#mod.request_uri,
+	?NICE("You don't have permission to execute " ++
+	      Info#mod.request_uri ++ " on this server")}}|
+      Info#mod.data]}.
+    
+	    
+
+%%
+%% Socket <-> Port communication
+%%
+
+proxy(#mod{config_db = ConfigDb} = Info, Port) ->
+    Timeout = httpd_util:lookup(ConfigDb, cgi_timeout, ?DEFAULT_CGI_TIMEOUT),
+    proxy(Info, Port, 0, undefined,[], Timeout).
+
+proxy(Info, Port, Size, StatusCode, AccResponse, Timeout) ->
+    ?vdebug("proxy -> entry with"
+	    "~n   Size:      ~p"
+	    "~n   StatusCode ~p"
+	    "~n   Timeout:   ~p",
+	    [Size, StatusCode, Timeout]),
+    receive
+	{Port, {data, Response}} when port(Port) ->
+	    ?vtrace("proxy -> got some data from the port",[]),
+	    
+	    NewStatusCode = update_status_code(StatusCode, Response),
+				  
+	    ?vtrace("proxy -> NewStatusCode: ~p",[NewStatusCode]),
+	    case send(Info, NewStatusCode, Response, Size, AccResponse) of
+		socket_closed ->
+		    ?vtrace("proxy -> socket closed: kill port",[]),
+		    (catch port_close(Port)), % KILL the port !!!!
+		    process_flag(trap_exit,false),
+		    {proceed,
+		     [{response,{already_sent,200,Size}}|Info#mod.data]};
+
+		head_sent ->
+		    ?vtrace("proxy -> head sent: kill port",[]),
+		    (catch port_close(Port)), % KILL the port !!!!
+		    process_flag(trap_exit,false),
+		    {proceed,
+		     [{response,{already_sent,200,Size}}|Info#mod.data]};
+
+		{http_response, NewAccResponse} ->
+		    ?vtrace("proxy -> head response: continue",[]),
+		    NewSize = get_new_size(Size, Response),
+		    proxy(Info, Port, NewSize, NewStatusCode,
+			  NewAccResponse, Timeout);
+
+		_ ->
+		    ?vtrace("proxy -> continue",[]),
+		    %% The data is sent and the socket is not closed, continue
+		    NewSize = get_new_size(Size, Response),
+		    proxy(Info, Port, NewSize, NewStatusCode,
+			  "nonempty", Timeout)
+	    end;
+
+	{'EXIT', Port, normal} when port(Port) ->
+	    ?vtrace("proxy -> exit signal from port: normal",[]),
+	    NewStatusCode = update_status_code(StatusCode,AccResponse),
+	    final_send(Info,NewStatusCode,Size,AccResponse),
+	    process_flag(trap_exit,false),
+	    {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]};
+
+	{'EXIT', Port, Reason} when port(Port) ->
+	    ?vtrace("proxy -> exit signal from port: ~p",[Reason]),
+	    process_flag(trap_exit, false),
+	    {proceed, [{status,{400,none,reason(Reason)}}|Info#mod.data]};
+
+	{'EXIT', Pid, Reason} when pid(Pid) ->
+	    %% This is the case that a linked process has died, 
+	    %% It would be nice to response with a server error 
+	    %% but since the heade alredy is sent
+	    ?vtrace("proxy -> exit signal from ~p: ~p",[Pid, Reason]),
+	    proxy(Info, Port, Size, StatusCode, AccResponse, Timeout);
+
+	%% This should not happen
+	WhatEver ->
+	    ?vinfo("proxy -> received garbage: ~n~p", [WhatEver]),
+	    NewStatusCode = update_status_code(StatusCode, AccResponse),
+	    final_send(Info, StatusCode, Size, AccResponse),
+	    process_flag(trap_exit, false),
+	    {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]}
+
+    after Timeout ->
+	    ?vlog("proxy -> timeout",[]),
+	    (catch port_close(Port)), % KILL the port !!!!
+	    httpd_socket:close(Info#mod.socket_type, Info#mod.socket),
+	    process_flag(trap_exit,false),
+	    {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]}
+    end.
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                    %%
+%% The functions that handles the sending of the data to the client   %%
+%%                                                                    %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%----------------------------------------------------------------------
+%% Send the header the first time the size of the body is Zero
+%%----------------------------------------------------------------------
+
+send(#mod{method = "HEAD"} = Info, StatusCode, Response, 0, []) ->
+    first_handle_head_request(Info, StatusCode, Response);
+send(Info, StatusCode, Response, 0, []) ->
+    first_handle_other_request(Info, StatusCode, Response);
+
+%%----------------------------------------------------------------------
+%% The size of the body is bigger than zero => 
+%% we have a part of the body to send
+%%----------------------------------------------------------------------
+send(Info, StatusCode, Response, Size, AccResponse) ->
+    handle_other_request(Info, StatusCode, Response).
+
+
+%%----------------------------------------------------------------------
+%% The function is called the last time when the port has closed 
+%%----------------------------------------------------------------------
+
+final_send(Info, StatusCode, Size, AccResponse)->
+    final_handle_other_request(Info, StatusCode).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                    %% 
+%% The code that handles the head requests                            %%
+%%                                                                    %% 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%----------------------------------------------------------------------
+%% The request is a head request if its a HTPT/1.1 request answer to it
+%% otherwise we must collect the size of hte body before we can answer.
+%% Return Values:
+%% head_sent
+%%----------------------------------------------------------------------
+first_handle_head_request(Info, StatusCode, Response)->
+    case Info#mod.http_version of
+	"HTTP/1.1" ->
+	    %% Since we have all we need to create the header create it 
+	    %% send it and return head_sent.
+	    case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
+		{ok, [HeadEnd, Rest]} ->
+		    HeadEnd1 = removeStatus(HeadEnd),
+		    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,
+					 [create_header(Info,StatusCode),
+					  HeadEnd1,"\r\n\r\n"]);
+		_ ->
+		    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,
+					 [create_header(Info, StatusCode),
+					  "Content-Type:text/html\r\n\r\n"])
+	    end;
+	_ ->
+	  Response1= case regexp:split(Response,"\r\n\r\n|\n\n") of
+			  {ok,[HeadEnd|Rest]} ->
+			     removeStatus(HeadEnd);
+			  _ ->
+			     ["Content-Type:text/html"]
+		     end,
+	    H1 = httpd_util:header(StatusCode,Info#mod.connection),
+	    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket, 
+				 [H1,Response1,"\r\n\r\n"])
+    end,    
+    head_sent.
+  
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                    %%
+%% Handle the requests that is to the other methods                   %%
+%%                                                                    %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%----------------------------------------------------------------------
+%% Create the http-response header and send it to the user if it is
+%% a http/1.1 request otherwise we must accumulate it 
+%%----------------------------------------------------------------------
+first_handle_other_request(Info,StatusCode,Response)->
+    Header = create_header(Info,StatusCode),
+    Response1 = 
+	case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
+	    {ok,[HeadPart,[]]} ->
+		[Header, removeStatus(HeadPart),"\r\n\r\n"];
+	    
+	    {ok,[HeadPart,BodyPart]} ->
+		      [Header, removeStatus(HeadPart), "\r\n\r\n",
+		       httpd_util:integer_to_hexlist(length(BodyPart)),
+		       "\r\n", BodyPart];
+	    _WhatEver ->
+		%% No response header field from the cgi-script, 
+		%% Just a body
+		[Header, "Content-Type:text/html","\r\n\r\n",
+		 httpd_util:integer_to_hexlist(length(Response)),
+		 "\r\n", Response]
+	end,
+    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket, Response1).
+
+
+handle_other_request(#mod{http_version = "HTTP/1.1", 
+			  socket_type = Type, socket = Sock} = Info, 
+		     StatusCode, Response0) ->
+    Response = create_chunk(Info, Response0),
+    httpd_socket:deliver(Type, Sock, Response);
+handle_other_request(#mod{socket_type = Type, socket = Sock} = Info, 
+		     StatusCode, Response) ->
+    httpd_socket:deliver(Type, Sock, Response).
+
+
+final_handle_other_request(#mod{http_version = "HTTP/1.1", 
+				socket_type = Type, socket = Sock}, 
+			   StatusCode) ->
+    httpd_socket:deliver(Type, Sock, "0\r\n");
+final_handle_other_request(#mod{socket_type = Type, socket = Sock}, 
+			   StatusCode) ->
+    httpd_socket:close(Type, Sock),
+    socket_closed.
+
+
+create_chunk(_Info, Response) ->
+    HEXSize = httpd_util:integer_to_hexlist(length(lists:flatten(Response))),
+    HEXSize++"\r\n"++Response++"\r\n".
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                    %%
+%% The various helper functions                                       %%
+%%                                                                    %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ 
+update_status_code(undefined, Response) ->
+    case status_code(Response) of
+	{ok, StatusCode1} ->
+	    StatusCode1;
+	_ ->	    
+	    ?vlog("invalid response from script:~n~p", [Response]),
+	    500
+    end;
+update_status_code(StatusCode,_Response)->
+    StatusCode.
+
+
+get_new_size(0,Response)->
+    case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
+	{ok,[Head,Body]}->
+	    length(lists:flatten(Body));
+	_ ->
+	    %%No header in the respone 
+	    length(lists:flatten(Response))
+    end;
+
+get_new_size(Size,Response)->
+    Size+length(lists:flatten(Response)).
+
+%%----------------------------------------------------------------------
+%% Creates the http-header for a response
+%%----------------------------------------------------------------------
+create_header(Info,StatusCode)->
+    Cache=case httpd_util:lookup(Info#mod.config_db,script_nocache,false) of
+	      true->
+		  Date=httpd_util:rfc1123_date(),
+		  "Cache-Control:no-cache\r\nPragma:no-cache\r\nExpires:"++ Date ++ "\r\n";
+	      false ->
+		  []
+	  end,
+    case Info#mod.http_version of 
+	"HTTP/1.1"  ->
+	    Header=httpd_util:header(StatusCode, Info#mod.connection),
+	    Header++"Transfer-encoding:chunked\r\n"++Cache;
+	_ ->
+	    httpd_util:header(StatusCode,Info#mod.connection)++Cache
+    end.
+
+
+
+%% status_code
+
+status_code(Response) ->
+  case httpd_util:split(Response,"\n\n|\r\n\r\n",2) of
+    {ok,[Header,Body]} ->
+      case regexp:split(Header,"\n|\r\n") of
+	{ok,HeaderFields} ->
+	  {ok,extract_status_code(HeaderFields)};
+	{error,_} ->
+	      {error, bad_script_output(Response)}
+      end;
+    _ ->
+	  %% No header field in the returned data return 200 the standard code
+	  {ok, 200}
+  end.
+
+bad_script_output(Bad) ->
+    lists:flatten(io_lib:format("Bad script output ~s",[Bad])).
+
+
+extract_status_code([]) ->
+  200;
+extract_status_code([[$L,$o,$c,$a,$t,$i,$o,$n,$:,$ |_]|_]) ->
+  302;
+extract_status_code([[$S,$t,$a,$t,$u,$s,$:,$ |CodeAndReason]|_]) ->
+  case httpd_util:split(CodeAndReason," ",2) of
+    {ok,[Code,_]} ->
+      list_to_integer(Code);
+    {ok,_} ->
+      200
+  end;
+extract_status_code([_|Rest]) ->
+  extract_status_code(Rest).
+
+
+sz(B) when binary(B) -> {binary,size(B)};
+sz(L) when list(L)   -> {list,length(L)};
+sz(_)                -> undefined.
+
+
+%% Convert error to printable string
+%%
+reason({error,emfile})     -> ": To many open files";
+reason({error,{enfile,_}}) -> ": File/port table overflow";
+reason({error,enomem})     -> ": Not enough memory";
+reason({error,eagain})     -> ": No more available OS processes";
+reason(_)                  -> "".
+
+removeStatus(Head)->
+    case httpd_util:split(Head,"Status:.\r\n",2) of
+	{ok,[HeadPart,HeadEnd]}->
+	    HeadPart++HeadEnd;
+	_ ->
+	    Head
+    end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                    %%
+%% There are 2 config directives for mod_cgi:                         %%
+%% ScriptNoCache true|false, defines whether the server shall add     %%
+%%                           header fields to stop proxies and        %%  
+%%                           clients from saving the page in history  %%
+%%                           or cache                                 %%
+%%                                                                    %%
+%% ScriptTimeout Seconds, The number of seconds that the server       %%
+%%                        maximum will wait for the script to         %%
+%%                        generate a part of the document             %%
+%%                                                                    %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+load([$S,$c,$r,$i,$p,$t,$N,$o,$C,$a,$c,$h,$e |CacheArg],[])->
+    case catch list_to_atom(httpd_conf:clean(CacheArg)) of
+        true ->
+	    {ok, [], {script_nocache,true}};
+	false ->
+	   {ok, [], {script_nocache,false}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(CacheArg)++
+			 " is an invalid ScriptNoCache directive")}
+    end;
+
+load([$S,$c,$r,$i,$p,$t,$T,$i,$m,$e,$o,$u,$t,$ |Timeout],[])->
+    case catch list_to_integer(httpd_conf:clean(Timeout)) of
+	TimeoutSec when integer(TimeoutSec)  ->
+	   {ok, [], {script_timeout,TimeoutSec*1000}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(Timeout)++
+			 " is an invalid ScriptTimeout")}
+    end.
+	
+