aboutsummaryrefslogtreecommitdiffstats
path: root/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets
diff options
context:
space:
mode:
authorStavros Aronis <[email protected]>2010-06-18 03:44:25 +0300
committerLukas Larsson <[email protected]>2011-02-18 12:03:18 +0100
commit98de31e836a04ccc8f5f9acd90b9ba0803a24ab5 (patch)
tree3f26237297b0b2d9040de1b97eeb7cd75bce2dfe /lib/dialyzer/test/r9c_tests_SUITE_data/src/inets
parent08cec89bb1e781157a75c13e72562258b271b469 (diff)
downloadotp-98de31e836a04ccc8f5f9acd90b9ba0803a24ab5.tar.gz
otp-98de31e836a04ccc8f5f9acd90b9ba0803a24ab5.tar.bz2
otp-98de31e836a04ccc8f5f9acd90b9ba0803a24ab5.zip
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.
Diffstat (limited to 'lib/dialyzer/test/r9c_tests_SUITE_data/src/inets')
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile178
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/ftp.erl1582
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.erl260
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.hrl127
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http_lib.erl745
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_handler.erl724
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_manager.erl542
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.erl596
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.hrl77
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor.erl176
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor_sup.erl118
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_conf.erl688
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_example.erl134
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_manager.erl1030
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_misc_sup.erl116
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_parse.erl348
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_request_handler.erl995
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_response.erl437
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_socket.erl381
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_sup.erl203
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_util.erl777
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.erl94
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.hrl65
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.app.src56
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.appup.src135
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.config2
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets_sup.erl158
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/jnets_httpd.hrl138
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_actions.erl92
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_alias.erl175
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.erl750
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.hrl27
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_dets.erl222
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_mnesia.erl276
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_plain.erl344
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_server.erl424
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_browser.erl214
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_cgi.erl694
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_dir.erl266
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_disk_log.erl405
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl490
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_get.erl179
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_head.erl89
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_htaccess.erl1150
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_include.erl726
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_log.erl250
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_range.erl397
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_responsecontrol.erl337
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security.erl307
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl728
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_trace.erl69
-rw-r--r--lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/uri.erl349
52 files changed, 19842 insertions, 0 deletions
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile
new file mode 100644
index 0000000000..ab0d7c0a63
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile
@@ -0,0 +1,178 @@
+# ``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: Makefile,v 1.1 2008/12/17 09:53:33 mikpe Exp $
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+
+VSN = $(INETS_VSN)
+APP_VSN = "inets-$(VSN)"
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/inets-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = \
+ ftp \
+ http \
+ http_lib \
+ httpc_handler \
+ httpc_manager \
+ uri \
+ httpd \
+ httpd_acceptor \
+ httpd_acceptor_sup \
+ httpd_conf \
+ httpd_example \
+ httpd_manager \
+ httpd_misc_sup \
+ httpd_parse \
+ httpd_request_handler \
+ httpd_response \
+ httpd_socket \
+ httpd_sup \
+ httpd_util \
+ httpd_verbosity \
+ inets_sup \
+ mod_actions \
+ mod_alias \
+ mod_auth \
+ mod_auth_plain \
+ mod_auth_dets \
+ mod_auth_mnesia \
+ mod_auth_server \
+ mod_browser \
+ mod_cgi \
+ mod_dir \
+ mod_disk_log \
+ mod_esi \
+ mod_get \
+ mod_head \
+ mod_htaccess \
+ mod_include \
+ mod_log \
+ mod_range \
+ mod_responsecontrol \
+ mod_trace \
+ mod_security \
+ mod_security_server
+
+HRL_FILES = httpd.hrl httpd_verbosity.hrl mod_auth.hrl \
+ http.hrl jnets_httpd.hrl
+
+ERL_FILES = $(MODULES:%=%.erl)
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
+
+APP_FILE= inets.app
+APPUP_FILE= inets.appup
+
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# INETS FLAGS
+# ----------------------------------------------------
+# DONT_USE_VERBOSITY = -Ddont_use_verbosity=true
+INETS_FLAGS = -D'SERVER_SOFTWARE="inets/$(VSN)"' \
+ -Ddefault_verbosity=silence \
+ $(DONT_USE_VERBOSITY)
+
+# INETS_DEBUG_DEFAULT = d
+ifeq ($(INETS_DEBUG),)
+ INETS_DEBUG = $(INETS_DEBUG_DEFAULT)
+endif
+
+ifeq ($(INETS_DEBUG),c)
+ INETS_FLAGS += -Dinets_cdebug -Dinets_debug -Dinets_log -Dinets_error
+endif
+ifeq ($(INETS_DEBUG),d)
+ INETS_FLAGS += -Dinets_debug -Dinets_log -Dinets_error
+endif
+ifeq ($(INETS_DEBUG),l)
+ INETS_FLAGS += -Dinets_log -Dinets_error
+endif
+ifeq ($(INETS_DEBUG),e)
+ INETS_FLAGS += -Dinets_error
+endif
+
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_FLAGS +=
+
+ifeq ($(WARN_UNUSED_WARS),true)
+ERL_COMPILE_FLAGS += +warn_unused_vars
+endif
+
+ERL_COMPILE_FLAGS += $(INETS_FLAGS) \
+ +'{parse_transform,sys_pre_attributes}' \
+ +'{attribute,insert,app_vsn,$(APP_VSN)}'
+
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+docs:
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+info:
+ @echo "INETS_DEBUG = $(INETS_DEBUG)"
+ @echo "INETS_FLAGS = $(INETS_FLAGS)"
+ @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)"
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/ftp.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/ftp.erl
new file mode 100644
index 0000000000..be06ec654c
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/ftp.erl
@@ -0,0 +1,1582 @@
+%% ``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: ftp.erl,v 1.2 2009/03/03 01:55:01 kostis Exp $
+%%
+-module(ftp).
+
+-behaviour(gen_server).
+
+%% This module implements an ftp client based on socket(3)/gen_tcp(3),
+%% file(3) and filename(3).
+%%
+
+
+-define(OPEN_TIMEOUT, 60*1000).
+-define(BYTE_TIMEOUT, 1000). % Timeout for _ONE_ byte to arrive. (ms)
+-define(OPER_TIMEOUT, 300). % Operation timeout (seconds)
+-define(FTP_PORT, 21).
+
+%% Client interface
+-export([cd/2, close/1, delete/2, formaterror/1, help/0,
+ lcd/2, lpwd/1, ls/1, ls/2,
+ mkdir/2, nlist/1, nlist/2,
+ open/1, open/2, open/3,
+ pwd/1,
+ recv/2, recv/3, recv_bin/2,
+ recv_chunk_start/2, recv_chunk/1,
+ rename/3, rmdir/2,
+ send/2, send/3, send_bin/3,
+ send_chunk_start/2, send_chunk/2, send_chunk_end/1,
+ type/2, user/3,user/4,account/2,
+ append/3, append/2, append_bin/3,
+ append_chunk/2, append_chunk_end/1, append_chunk_start/2]).
+
+%% Internal
+-export([init/1, handle_call/3, handle_cast/2,
+ handle_info/2, terminate/2,code_change/3]).
+
+
+%%
+%% CLIENT FUNCTIONS
+%%
+
+%% open(Host)
+%% open(Host, Flags)
+%%
+%% Purpose: Start an ftp client and connect to a host.
+%% Args: Host = string(),
+%% Port = integer(),
+%% Flags = [Flag],
+%% Flag = verbose | debug
+%% Returns: {ok, Pid} | {error, ehost}
+
+%%Tho only option was the host in textual form
+open({option_list,Option_list})->
+ %% Dbg = {debug,[trace,log,statistics]},
+ %% Options = [Dbg],
+ Options = [],
+ {ok,Pid1}=case lists:keysearch(flags,1,Option_list) of
+ {value,{flags,Flags}}->
+ {ok, Pid} = gen_server:start_link(?MODULE, [Flags], Options);
+ false ->
+ {ok, Pid} = gen_server:start_link(?MODULE, [], Options)
+ end,
+ gen_server:call(Pid1, {open, ip_comm,Option_list}, infinity);
+
+
+%%The only option was the tuple form of the ip-number
+open(Host)when tuple(Host) ->
+ open(Host, ?FTP_PORT, []);
+
+%%Host is the string form of the hostname
+open(Host)->
+ open(Host,?FTP_PORT,[]).
+
+
+
+open(Host, Port) when integer(Port) ->
+ open(Host,Port,[]);
+
+open(Host, Flags) when list(Flags) ->
+ open(Host,?FTP_PORT, Flags).
+
+open(Host,Port,Flags) when integer(Port), list(Flags) ->
+ %% Dbg = {debug,[trace,log,statistics]},
+ %% Options = [Dbg],
+ Options = [],
+ {ok, Pid} = gen_server:start_link(?MODULE, [Flags], Options),
+ gen_server:call(Pid, {open, ip_comm, Host, Port}, infinity).
+
+%% user(Pid, User, Pass)
+%% Purpose: Login.
+%% Args: Pid = pid(), User = Pass = string()
+%% Returns: ok | {error, euser} | {error, econn}
+user(Pid, User, Pass) ->
+ gen_server:call(Pid, {user, User, Pass}, infinity).
+
+%% user(Pid, User, Pass,Acc)
+%% Purpose: Login whith a supplied account name
+%% Args: Pid = pid(), User = Pass = Acc = string()
+%% Returns: ok | {error, euser} | {error, econn} | {error, eacct}
+user(Pid, User, Pass,Acc) ->
+ gen_server:call(Pid, {user, User, Pass,Acc}, infinity).
+
+%% account(Pid,Acc)
+%% Purpose: Set a user Account.
+%% Args: Pid = pid(), Acc= string()
+%% Returns: ok | {error, eacct}
+account(Pid,Acc) ->
+ gen_server:call(Pid, {account,Acc}, infinity).
+
+%% pwd(Pid)
+%%
+%% Purpose: Get the current working directory at remote server.
+%% Args: Pid = pid()
+%% Returns: {ok, Dir} | {error, elogin} | {error, econn}
+pwd(Pid) ->
+ gen_server:call(Pid, pwd, infinity).
+
+%% lpwd(Pid)
+%%
+%% Purpose: Get the current working directory at local server.
+%% Args: Pid = pid()
+%% Returns: {ok, Dir} | {error, elogin}
+lpwd(Pid) ->
+ gen_server:call(Pid, lpwd, infinity).
+
+%% cd(Pid, Dir)
+%%
+%% Purpose: Change current working directory at remote server.
+%% Args: Pid = pid(), Dir = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+cd(Pid, Dir) ->
+ gen_server:call(Pid, {cd, Dir}, infinity).
+
+%% lcd(Pid, Dir)
+%%
+%% Purpose: Change current working directory for the local client.
+%% Args: Pid = pid(), Dir = string()
+%% Returns: ok | {error, epath}
+lcd(Pid, Dir) ->
+ gen_server:call(Pid, {lcd, Dir}, infinity).
+
+%% ls(Pid)
+%% ls(Pid, Dir)
+%%
+%% Purpose: List the contents of current directory (ls/1) or directory
+%% Dir (ls/2) at remote server.
+%% Args: Pid = pid(), Dir = string()
+%% Returns: {ok, Listing} | {error, epath} | {error, elogin} | {error, econn}
+ls(Pid) ->
+ ls(Pid, "").
+ls(Pid, Dir) ->
+ gen_server:call(Pid, {dir, long, Dir}, infinity).
+
+%% nlist(Pid)
+%% nlist(Pid, Dir)
+%%
+%% Purpose: List the contents of current directory (ls/1) or directory
+%% Dir (ls/2) at remote server. The returned list is a stream
+%% of file names.
+%% Args: Pid = pid(), Dir = string()
+%% Returns: {ok, Listing} | {error, epath} | {error, elogin} | {error, econn}
+nlist(Pid) ->
+ nlist(Pid, "").
+nlist(Pid, Dir) ->
+ gen_server:call(Pid, {dir, short, Dir}, infinity).
+
+%% rename(Pid, CurrFile, NewFile)
+%%
+%% Purpose: Rename a file at remote server.
+%% Args: Pid = pid(), CurrFile = NewFile = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+rename(Pid, CurrFile, NewFile) ->
+ gen_server:call(Pid, {rename, CurrFile, NewFile}, infinity).
+
+%% delete(Pid, File)
+%%
+%% Purpose: Remove file at remote server.
+%% Args: Pid = pid(), File = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+delete(Pid, File) ->
+ gen_server:call(Pid, {delete, File}, infinity).
+
+%% mkdir(Pid, Dir)
+%%
+%% Purpose: Make directory at remote server.
+%% Args: Pid = pid(), Dir = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+mkdir(Pid, Dir) ->
+ gen_server:call(Pid, {mkdir, Dir}, infinity).
+
+%% rmdir(Pid, Dir)
+%%
+%% Purpose: Remove directory at remote server.
+%% Args: Pid = pid(), Dir = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+rmdir(Pid, Dir) ->
+ gen_server:call(Pid, {rmdir, Dir}, infinity).
+
+%% type(Pid, Type)
+%%
+%% Purpose: Set transfer type.
+%% Args: Pid = pid(), Type = ascii | binary
+%% Returns: ok | {error, etype} | {error, elogin} | {error, econn}
+type(Pid, Type) ->
+ gen_server:call(Pid, {type, Type}, infinity).
+
+%% recv(Pid, RFile [, LFile])
+%%
+%% Purpose: Transfer file from remote server.
+%% Args: Pid = pid(), RFile = LFile = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+recv(Pid, RFile) ->
+ recv(Pid, RFile, "").
+
+recv(Pid, RFile, LFile) ->
+ gen_server:call(Pid, {recv, RFile, LFile}, infinity).
+
+%% recv_bin(Pid, RFile)
+%%
+%% Purpose: Transfer file from remote server into binary.
+%% Args: Pid = pid(), RFile = string()
+%% Returns: {ok, Bin} | {error, epath} | {error, elogin} | {error, econn}
+recv_bin(Pid, RFile) ->
+ gen_server:call(Pid, {recv_bin, RFile}, infinity).
+
+%% recv_chunk_start(Pid, RFile)
+%%
+%% Purpose: Start receive of chunks of remote file.
+%% Args: Pid = pid(), RFile = string().
+%% Returns: ok | {error, elogin} | {error, epath} | {error, econn}
+recv_chunk_start(Pid, RFile) ->
+ gen_server:call(Pid, {recv_chunk_start, RFile}, infinity).
+
+
+%% recv_chunk(Pid, RFile)
+%%
+%% Purpose: Transfer file from remote server into binary in chunks
+%% Args: Pid = pid(), RFile = string()
+%% Returns: Reference
+recv_chunk(Pid) ->
+ gen_server:call(Pid, recv_chunk, infinity).
+
+%% send(Pid, LFile [, RFile])
+%%
+%% Purpose: Transfer file to remote server.
+%% Args: Pid = pid(), LFile = RFile = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+send(Pid, LFile) ->
+ send(Pid, LFile, "").
+
+send(Pid, LFile, RFile) ->
+ gen_server:call(Pid, {send, LFile, RFile}, infinity).
+
+%% send_bin(Pid, Bin, RFile)
+%%
+%% Purpose: Transfer a binary to a remote file.
+%% Args: Pid = pid(), Bin = binary(), RFile = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, enotbinary}
+%% | {error, econn}
+send_bin(Pid, Bin, RFile) when binary(Bin) ->
+ gen_server:call(Pid, {send_bin, Bin, RFile}, infinity);
+send_bin(Pid, Bin, RFile) ->
+ {error, enotbinary}.
+
+%% send_chunk_start(Pid, RFile)
+%%
+%% Purpose: Start transfer of chunks to remote file.
+%% Args: Pid = pid(), RFile = string().
+%% Returns: ok | {error, elogin} | {error, epath} | {error, econn}
+send_chunk_start(Pid, RFile) ->
+ gen_server:call(Pid, {send_chunk_start, RFile}, infinity).
+
+
+%% append_chunk_start(Pid, RFile)
+%%
+%% Purpose: Start append chunks of data to remote file.
+%% Args: Pid = pid(), RFile = string().
+%% Returns: ok | {error, elogin} | {error, epath} | {error, econn}
+append_chunk_start(Pid, RFile) ->
+ gen_server:call(Pid, {append_chunk_start, RFile}, infinity).
+
+
+%% send_chunk(Pid, Bin)
+%%
+%% Purpose: Send chunk to remote file.
+%% Args: Pid = pid(), Bin = binary().
+%% Returns: ok | {error, elogin} | {error, enotbinary} | {error, echunk}
+%% | {error, econn}
+send_chunk(Pid, Bin) when binary(Bin) ->
+ gen_server:call(Pid, {send_chunk, Bin}, infinity);
+send_chunk(Pid, Bin) ->
+ {error, enotbinary}.
+
+%%append_chunk(Pid, Bin)
+%%
+%% Purpose: Append chunk to remote file.
+%% Args: Pid = pid(), Bin = binary().
+%% Returns: ok | {error, elogin} | {error, enotbinary} | {error, echunk}
+%% | {error, econn}
+append_chunk(Pid, Bin) when binary(Bin) ->
+ gen_server:call(Pid, {append_chunk, Bin}, infinity);
+append_chunk(Pid, Bin) ->
+ {error, enotbinary}.
+
+%% send_chunk_end(Pid)
+%%
+%% Purpose: End sending of chunks to remote file.
+%% Args: Pid = pid().
+%% Returns: ok | {error, elogin} | {error, echunk} | {error, econn}
+send_chunk_end(Pid) ->
+ gen_server:call(Pid, send_chunk_end, infinity).
+
+%% append_chunk_end(Pid)
+%%
+%% Purpose: End appending of chunks to remote file.
+%% Args: Pid = pid().
+%% Returns: ok | {error, elogin} | {error, echunk} | {error, econn}
+append_chunk_end(Pid) ->
+ gen_server:call(Pid, append_chunk_end, infinity).
+
+%% append(Pid, LFile,RFile)
+%%
+%% Purpose: Append the local file to the remote file
+%% Args: Pid = pid(), LFile = RFile = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, econn}
+append(Pid, LFile) ->
+ append(Pid, LFile, "").
+
+append(Pid, LFile, RFile) ->
+ gen_server:call(Pid, {append, LFile, RFile}, infinity).
+
+%% append_bin(Pid, Bin, RFile)
+%%
+%% Purpose: Append a binary to a remote file.
+%% Args: Pid = pid(), Bin = binary(), RFile = string()
+%% Returns: ok | {error, epath} | {error, elogin} | {error, enotbinary}
+%% | {error, econn}
+append_bin(Pid, Bin, RFile) when binary(Bin) ->
+ gen_server:call(Pid, {append_bin, Bin, RFile}, infinity);
+append_bin(Pid, Bin, RFile) ->
+ {error, enotbinary}.
+
+
+%% close(Pid)
+%%
+%% Purpose: End the ftp session.
+%% Args: Pid = pid()
+%% Returns: ok
+close(Pid) ->
+ case (catch gen_server:call(Pid, close, 30000)) of
+ ok ->
+ ok;
+ {'EXIT',{noproc,_}} ->
+ %% Already gone...
+ ok;
+ Res ->
+ Res
+ end.
+
+%% formaterror(Tag)
+%%
+%% Purpose: Return diagnostics.
+%% Args: Tag = atom() | {error, atom()}
+%% Returns: string().
+formaterror(Tag) ->
+ errstr(Tag).
+
+%% help()
+%%
+%% Purpose: Print list of valid commands.
+%%
+%% Undocumented.
+%%
+help() ->
+ io:format("\n Commands:\n"
+ " ---------\n"
+ " cd(Pid, Dir)\n"
+ " close(Pid)\n"
+ " delete(Pid, File)\n"
+ " formaterror(Tag)\n"
+ " help()\n"
+ " lcd(Pid, Dir)\n"
+ " lpwd(Pid)\n"
+ " ls(Pid [, Dir])\n"
+ " mkdir(Pid, Dir)\n"
+ " nlist(Pid [, Dir])\n"
+ " open(Host [Port, Flags])\n"
+ " pwd(Pid)\n"
+ " recv(Pid, RFile [, LFile])\n"
+ " recv_bin(Pid, RFile)\n"
+ " recv_chunk_start(Pid, RFile)\n"
+ " recv_chunk(Pid)\n"
+ " rename(Pid, CurrFile, NewFile)\n"
+ " rmdir(Pid, Dir)\n"
+ " send(Pid, LFile [, RFile])\n"
+ " send_chunk(Pid, Bin)\n"
+ " send_chunk_start(Pid, RFile)\n"
+ " send_chunk_end(Pid)\n"
+ " send_bin(Pid, Bin, RFile)\n"
+ " append(Pid, LFile [, RFile])\n"
+ " append_chunk(Pid, Bin)\n"
+ " append_chunk_start(Pid, RFile)\n"
+ " append_chunk_end(Pid)\n"
+ " append_bin(Pid, Bin, RFile)\n"
+ " type(Pid, Type)\n"
+ " account(Pid,Account)\n"
+ " user(Pid, User, Pass)\n"
+ " user(Pid, User, Pass,Account)\n").
+
+%%
+%% INIT
+%%
+
+-record(state, {csock = undefined, dsock = undefined, flags = undefined,
+ ldir = undefined, type = undefined, chunk = false,
+ pending = undefined}).
+
+init([Flags]) ->
+ sock_start(),
+ put(debug,get_debug(Flags)),
+ put(verbose,get_verbose(Flags)),
+ process_flag(priority, low),
+ {ok, LDir} = file:get_cwd(),
+ {ok, #state{flags = Flags, ldir = LDir}}.
+
+%%
+%% HANDLERS
+%%
+
+%% First group of reply code digits
+-define(POS_PREL, 1).
+-define(POS_COMPL, 2).
+-define(POS_INTERM, 3).
+-define(TRANS_NEG_COMPL, 4).
+-define(PERM_NEG_COMPL, 5).
+
+%% Second group of reply code digits
+-define(SYNTAX,0).
+-define(INFORMATION,1).
+-define(CONNECTION,2).
+-define(AUTH_ACC,3).
+-define(UNSPEC,4).
+-define(FILE_SYSTEM,5).
+
+
+-define(STOP_RET(E),{stop, normal, {error, E},
+ State#state{csock = undefined}}).
+
+
+rescode(?POS_PREL,_,_) -> pos_prel; %%Positive Preleminary Reply
+rescode(?POS_COMPL,_,_) -> pos_compl; %%Positive Completion Reply
+rescode(?POS_INTERM,?AUTH_ACC,2) -> pos_interm_acct; %%Positive Intermediate Reply nedd account
+rescode(?POS_INTERM,_,_) -> pos_interm; %%Positive Intermediate Reply
+rescode(?TRANS_NEG_COMPL,?FILE_SYSTEM,2) -> trans_no_space; %%No storage area no action taken
+rescode(?TRANS_NEG_COMPL,_,_) -> trans_neg_compl;%%Temporary Error, no action taken
+rescode(?PERM_NEG_COMPL,?FILE_SYSTEM,2) -> perm_no_space; %%Permanent disk space error, the user shall not try again
+rescode(?PERM_NEG_COMPL,?FILE_SYSTEM,3) -> perm_fname_not_allowed;
+rescode(?PERM_NEG_COMPL,_,_) -> perm_neg_compl.
+
+retcode(trans_no_space,_) -> etnospc;
+retcode(perm_no_space,_) -> epnospc;
+retcode(perm_fname_not_allowed,_) -> efnamena;
+retcode(_,Otherwise) -> Otherwise.
+
+handle_call({open,ip_comm,Conn_data},From,State) ->
+ case lists:keysearch(host,1,Conn_data) of
+ {value,{host,Host}}->
+ Port=get_key1(port,Conn_data,?FTP_PORT),
+ Timeout=get_key1(timeout,Conn_data,?OPEN_TIMEOUT),
+ open(Host,Port,Timeout,State);
+ false ->
+ ehost
+ end;
+
+handle_call({open,ip_comm,Host,Port},From,State) ->
+ open(Host,Port,?OPEN_TIMEOUT,State);
+
+handle_call({user, User, Pass}, _From, State) ->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock, "USER ~s", [User]) of
+ pos_interm ->
+ case ctrl_cmd(CSock, "PASS ~s", [Pass]) of
+ pos_compl ->
+ set_type(binary, CSock),
+ {reply, ok, State#state{type = binary}};
+ {error,enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, euser}, State}
+ end;
+ pos_compl ->
+ set_type(binary, CSock),
+ {reply, ok, State#state{type = binary}};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, euser}, State}
+ end;
+
+handle_call({user, User, Pass,Acc}, _From, State) ->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock, "USER ~s", [User]) of
+ pos_interm ->
+ case ctrl_cmd(CSock, "PASS ~s", [Pass]) of
+ pos_compl ->
+ set_type(binary, CSock),
+ {reply, ok, State#state{type = binary}};
+ pos_interm_acct->
+ case ctrl_cmd(CSock,"ACCT ~s",[Acc]) of
+ pos_compl->
+ set_type(binary, CSock),
+ {reply, ok, State#state{type = binary}};
+ {error,enotconn}->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, eacct}, State}
+ end;
+ {error,enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, euser}, State}
+ end;
+ pos_compl ->
+ set_type(binary, CSock),
+ {reply, ok, State#state{type = binary}};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, euser}, State}
+ end;
+
+%%set_account(Acc,State)->Reply
+%%Reply={reply, {error, euser}, State} | {error,enotconn}->
+handle_call({account,Acc},_From,State)->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock,"ACCT ~s",[Acc]) of
+ pos_compl->
+ {reply, ok,State};
+ {error,enotconn}->
+ ?STOP_RET(econn);
+ Error ->
+ debug(" error: ~p",[Error]),
+ {reply, {error, eacct}, State}
+ end;
+
+handle_call(pwd, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ %%
+ %% NOTE: The directory string comes over the control connection.
+ case sock_write(CSock, mk_cmd("PWD", [])) of
+ ok ->
+ {_, Line} = result_line(CSock),
+ {_, Cs} = split($", Line), % XXX Ugly
+ {Dir0, _} = split($", Cs),
+ Dir = lists:delete($", Dir0),
+ {reply, {ok, Dir}, State};
+ {error, enotconn} ->
+ ?STOP_RET(econn)
+ end;
+
+handle_call(lpwd, _From, State) ->
+ #state{csock = CSock, ldir = LDir} = State,
+ {reply, {ok, LDir}, State};
+
+handle_call({cd, Dir}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock, "CWD ~s", [Dir]) of
+ pos_compl ->
+ {reply, ok, State};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({lcd, Dir}, _From, State) ->
+ #state{csock = CSock, ldir = LDir0} = State,
+ LDir = absname(LDir0, Dir),
+ case file:read_file_info(LDir) of
+ {ok, _ } ->
+ {reply, ok, State#state{ldir = LDir}};
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({dir, Len, Dir}, _From, State) when State#state.chunk == false ->
+ debug(" dir : ~p: ~s~n",[Len,Dir]),
+ #state{csock = CSock, type = Type} = State,
+ set_type(ascii, Type, CSock),
+ LSock = listen_data(CSock, raw),
+ Cmd = case Len of
+ short -> "NLST";
+ long -> "LIST"
+ end,
+ Result = case Dir of
+ "" ->
+ ctrl_cmd(CSock, Cmd, "");
+ _ ->
+ ctrl_cmd(CSock, Cmd ++ " ~s", [Dir])
+ end,
+ debug(" ctrl : command result: ~p~n",[Result]),
+ case Result of
+ pos_prel ->
+ debug(" dbg : await the data connection", []),
+ DSock = accept_data(LSock),
+ debug(" dbg : await the data", []),
+ Reply0 =
+ case recv_data(DSock) of
+ {ok, DirData} ->
+ debug(" data : DirData: ~p~n",[DirData]),
+ case result(CSock) of
+ pos_compl ->
+ {ok, DirData};
+ _ ->
+ {error, epath}
+ end;
+ {error, Reason} ->
+ sock_close(DSock),
+ verbose(" data : error: ~p, ~p~n",[Reason, result(CSock)]),
+ {error, epath}
+ end,
+
+ debug(" ctrl : reply: ~p~n",[Reply0]),
+ reset_type(ascii, Type, CSock),
+ {reply, Reply0, State};
+ {closed, _Why} ->
+ ?STOP_RET(econn);
+ _ ->
+ sock_close(LSock),
+ {reply, {error, epath}, State}
+ end;
+
+
+handle_call({rename, CurrFile, NewFile}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock, "RNFR ~s", [CurrFile]) of
+ pos_interm ->
+ case ctrl_cmd(CSock, "RNTO ~s", [NewFile]) of
+ pos_compl ->
+ {reply, ok, State};
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({delete, File}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock, "DELE ~s", [File]) of
+ pos_compl ->
+ {reply, ok, State};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({mkdir, Dir}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock, "MKD ~s", [Dir]) of
+ pos_compl ->
+ {reply, ok, State};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({rmdir, Dir}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ case ctrl_cmd(CSock, "RMD ~s", [Dir]) of
+ pos_compl ->
+ {reply, ok, State};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({type, Type}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ case Type of
+ ascii ->
+ set_type(ascii, CSock),
+ {reply, ok, State#state{type = ascii}};
+ binary ->
+ set_type(binary, CSock),
+ {reply, ok, State#state{type = binary}};
+ _ ->
+ {reply, {error, etype}, State}
+ end;
+
+handle_call({recv, RFile, LFile}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock, ldir = LDir} = State,
+ ALFile = case LFile of
+ "" ->
+ absname(LDir, RFile);
+ _ ->
+ absname(LDir, LFile)
+ end,
+ case file_open(ALFile, write) of
+ {ok, Fd} ->
+ LSock = listen_data(CSock, binary),
+ Ret = case ctrl_cmd(CSock, "RETR ~s", [RFile]) of
+ pos_prel ->
+ DSock = accept_data(LSock),
+ recv_file(DSock, Fd),
+ Reply0 = case result(CSock) of
+ pos_compl ->
+ ok;
+ _ ->
+ {error, epath}
+ end,
+ sock_close(DSock),
+ {reply, Reply0, State};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, epath}, State}
+ end,
+ file_close(Fd),
+ Ret;
+ {error, _What} ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({recv_bin, RFile}, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock, ldir = LDir} = State,
+ LSock = listen_data(CSock, binary),
+ case ctrl_cmd(CSock, "RETR ~s", [RFile]) of
+ pos_prel ->
+ DSock = accept_data(LSock),
+ Reply = recv_binary(DSock,CSock),
+ sock_close(DSock),
+ {reply, Reply, State};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+
+handle_call({recv_chunk_start, RFile}, _From, State)
+ when State#state.chunk == false ->
+ start_chunk_transfer("RETR",RFile,State);
+
+handle_call(recv_chunk, _From, State)
+ when State#state.chunk == true ->
+ do_recv_chunk(State);
+
+
+handle_call({send, LFile, RFile}, _From, State)
+ when State#state.chunk == false ->
+ transfer_file("STOR",LFile,RFile,State);
+
+handle_call({append, LFile, RFile}, _From, State)
+ when State#state.chunk == false ->
+ transfer_file("APPE",LFile,RFile,State);
+
+
+handle_call({send_bin, Bin, RFile}, _From, State)
+ when State#state.chunk == false ->
+ transfer_data("STOR",Bin,RFile,State);
+
+handle_call({append_bin, Bin, RFile}, _From, State)
+ when State#state.chunk == false ->
+ transfer_data("APPE",Bin,RFile,State);
+
+
+
+handle_call({send_chunk_start, RFile}, _From, State)
+ when State#state.chunk == false ->
+ start_chunk_transfer("STOR",RFile,State);
+
+handle_call({append_chunk_start,RFile},_From,State)
+ when State#state.chunk==false->
+ start_chunk_transfer("APPE",RFile,State);
+
+handle_call({send_chunk, Bin}, _From, State)
+ when State#state.chunk == true ->
+ chunk_transfer(Bin,State);
+
+handle_call({append_chunk, Bin}, _From, State)
+ when State#state.chunk == true ->
+ chunk_transfer(Bin,State);
+
+handle_call(append_chunk_end, _From, State)
+ when State#state.chunk == true ->
+ end_chunk_transfer(State);
+
+handle_call(send_chunk_end, _From, State)
+ when State#state.chunk == true ->
+ end_chunk_transfer(State);
+
+
+
+handle_call(close, _From, State) when State#state.chunk == false ->
+ #state{csock = CSock} = State,
+ ctrl_cmd(CSock, "QUIT", []),
+ sock_close(CSock),
+ {stop, normal, ok, State};
+
+handle_call(_, _From, State) when State#state.chunk == true ->
+ {reply, {error, echunk}, State}.
+
+
+handle_cast(Msg, State) ->
+ {noreply, State}.
+
+
+handle_info({Sock, {fromsocket, Bytes}}, State) when Sock == State#state.csock ->
+ put(leftovers, Bytes ++ leftovers()),
+ {noreply, State};
+
+%% Data connection closed (during chunk sending)
+handle_info({Sock, {socket_closed, _Reason}}, State) when Sock == State#state.dsock ->
+ {noreply, State#state{dsock = undefined}};
+
+%% Control connection closed.
+handle_info({Sock, {socket_closed, _Reason}}, State) when Sock == State#state.csock ->
+ debug(" sc : ~s~n",[leftovers()]),
+ {stop, ftp_server_close, State#state{csock = undefined}};
+
+handle_info(Info, State) ->
+ error_logger:info_msg("ftp : ~w : Unexpected message: ~w\n", [self(),Info]),
+ {noreply, State}.
+
+code_change(OldVsn,State,Extra)->
+ {ok,State}.
+
+terminate(Reason, State) ->
+ ok.
+%%
+%% OPEN CONNECTION
+%%
+open(Host,Port,Timeout,State)->
+ case sock_connect(Host,Port,Timeout) of
+ {error, What} ->
+ {stop, normal, {error, What}, State};
+ CSock ->
+ case result(CSock, State#state.flags) of
+ {error,Reason} ->
+ sock_close(CSock),
+ {stop,normal,{error,Reason},State};
+ _ -> % We should really check this...
+ {reply, {ok, self()}, State#state{csock = CSock}}
+ end
+ end.
+
+
+
+%%
+%% CONTROL CONNECTION
+%%
+
+ctrl_cmd(CSock, Fmt, Args) ->
+ Cmd = mk_cmd(Fmt, Args),
+ case sock_write(CSock, Cmd) of
+ ok ->
+ debug(" cmd : ~s",[Cmd]),
+ result(CSock);
+ {error, enotconn} ->
+ {error, enotconn};
+ Other ->
+ Other
+ end.
+
+mk_cmd(Fmt, Args) ->
+ [io_lib:format(Fmt, Args)| "\r\n"]. % Deep list ok.
+
+%%
+%% TRANSFER TYPE
+%%
+
+%%
+%% set_type(NewType, CurrType, CSock)
+%% reset_type(NewType, CurrType, CSock)
+%%
+set_type(Type, Type, CSock) ->
+ ok;
+set_type(NewType, _OldType, CSock) ->
+ set_type(NewType, CSock).
+
+reset_type(Type, Type, CSock) ->
+ ok;
+reset_type(_NewType, OldType, CSock) ->
+ set_type(OldType, CSock).
+
+set_type(ascii, CSock) ->
+ ctrl_cmd(CSock, "TYPE A", []);
+set_type(binary, CSock) ->
+ ctrl_cmd(CSock, "TYPE I", []).
+
+%%
+%% DATA CONNECTION
+%%
+
+%% Create a listen socket for a data connection and send a PORT command
+%% containing the IP address and port number. Mode is binary or raw.
+%%
+listen_data(CSock, Mode) ->
+ {IP, _} = sock_name(CSock), % IP address of control conn.
+ LSock = sock_listen(Mode, IP),
+ Port = sock_listen_port(LSock),
+ {A1, A2, A3, A4} = IP,
+ {P1, P2} = {Port div 256, Port rem 256},
+ ctrl_cmd(CSock, "PORT ~w,~w,~w,~w,~w,~w", [A1, A2, A3, A4, P1, P2]),
+ LSock.
+
+%%
+%% Accept the data connection and close the listen socket.
+%%
+accept_data(LSock) ->
+ Sock = sock_accept(LSock),
+ sock_close(LSock),
+ Sock.
+
+%%
+%% DATA COLLECTION (ls, dir)
+%%
+%% Socket is a byte stream in ASCII mode.
+%%
+
+%% Receive data (from data connection).
+recv_data(Sock) ->
+ recv_data(Sock, [], 0).
+recv_data(Sock, Sofar, ?OPER_TIMEOUT) ->
+ sock_close(Sock),
+ {ok, lists:flatten(lists:reverse(Sofar))};
+recv_data(Sock, Sofar, Retry) ->
+ case sock_read(Sock) of
+ {ok, Data} ->
+ debug(" dbg : received some data: ~n~s", [Data]),
+ recv_data(Sock, [Data| Sofar], 0);
+ {error, timeout} ->
+ %% Retry..
+ recv_data(Sock, Sofar, Retry+1);
+ {error, Reason} ->
+ SoFar1 = lists:flatten(lists:reverse(Sofar)),
+ {error, {socket_error, Reason, SoFar1, Retry}};
+ {closed, _} ->
+ {ok, lists:flatten(lists:reverse(Sofar))}
+ end.
+
+%%
+%% BINARY TRANSFER
+%%
+
+%% --------------------------------------------------
+
+%% recv_binary(DSock,CSock) = {ok,Bin} | {error,Reason}
+%%
+recv_binary(DSock,CSock) ->
+ recv_binary1(recv_binary2(DSock,[],0),CSock).
+
+recv_binary1(Reply,Sock) ->
+ case result(Sock) of
+ pos_compl -> Reply;
+ _ -> {error, epath}
+ end.
+
+recv_binary2(Sock, _Bs, ?OPER_TIMEOUT) ->
+ sock_close(Sock),
+ {error,eclosed};
+recv_binary2(Sock, Bs, Retry) ->
+ case sock_read(Sock) of
+ {ok, Bin} ->
+ recv_binary2(Sock, [Bs, Bin], 0);
+ {error, timeout} ->
+ recv_binary2(Sock, Bs, Retry+1);
+ {closed, _Why} ->
+ {ok,list_to_binary(Bs)}
+ end.
+
+%% --------------------------------------------------
+
+%%
+%% recv_chunk
+%%
+
+do_recv_chunk(#state{dsock = undefined} = State) ->
+ {reply, {error,econn}, State};
+do_recv_chunk(State) ->
+ recv_chunk1(recv_chunk2(State, 0), State).
+
+recv_chunk1({ok, _Bin} = Reply, State) ->
+ {reply, Reply, State};
+%% Reply = ok | {error, Reason}
+recv_chunk1(Reply, #state{csock = CSock} = State) ->
+ State1 = State#state{dsock = undefined, chunk = false},
+ case result(CSock) of
+ pos_compl ->
+ {reply, Reply, State1};
+ _ ->
+ {reply, {error, epath}, State1}
+ end.
+
+recv_chunk2(#state{dsock = DSock} = State, ?OPER_TIMEOUT) ->
+ sock_close(DSock),
+ {error, eclosed};
+recv_chunk2(#state{dsock = DSock} = State, Retry) ->
+ case sock_read(DSock) of
+ {ok, Bin} ->
+ {ok, Bin};
+ {error, timeout} ->
+ recv_chunk2(State, Retry+1);
+ {closed, Reason} ->
+ debug(" dbg : socket closed: ~p", [Reason]),
+ ok
+ end.
+
+
+%% --------------------------------------------------
+
+%%
+%% FILE TRANSFER
+%%
+
+recv_file(Sock, Fd) ->
+ recv_file(Sock, Fd, 0).
+
+recv_file(Sock, Fd, ?OPER_TIMEOUT) ->
+ sock_close(Sock),
+ {closed, timeout};
+recv_file(Sock, Fd, Retry) ->
+ case sock_read(Sock) of
+ {ok, Bin} ->
+ file_write(Fd, Bin),
+ recv_file(Sock, Fd);
+ {error, timeout} ->
+ recv_file(Sock, Fd, Retry+1);
+% {error, Reason} ->
+% SoFar1 = lists:flatten(lists:reverse(Sofar)),
+% exit({socket_error, Reason, Sock, SoFar1, Retry});
+ {closed, How} ->
+ {closed, How}
+ end.
+
+%%
+%% send_file(Fd, Sock) = ok | {error, Why}
+%%
+
+send_file(Fd, Sock) ->
+ {N, Bin} = file_read(Fd),
+ if
+ N > 0 ->
+ case sock_write(Sock, Bin) of
+ ok ->
+ send_file(Fd, Sock);
+ {error, Reason} ->
+ {error, Reason}
+ end;
+ true ->
+ ok
+ end.
+
+
+
+%%
+%% PARSING OF RESULT LINES
+%%
+
+%% Excerpt from RFC 959:
+%%
+%% "A reply is defined to contain the 3-digit code, followed by Space
+%% <SP>, followed by one line of text (where some maximum line length
+%% has been specified), and terminated by the Telnet end-of-line
+%% code. There will be cases however, where the text is longer than
+%% a single line. In these cases the complete text must be bracketed
+%% so the User-process knows when it may stop reading the reply (i.e.
+%% stop processing input on the control connection) and go do other
+%% things. This requires a special format on the first line to
+%% indicate that more than one line is coming, and another on the
+%% last line to designate it as the last. At least one of these must
+%% contain the appropriate reply code to indicate the state of the
+%% transaction. To satisfy all factions, it was decided that both
+%% the first and last line codes should be the same.
+%%
+%% Thus the format for multi-line replies is that the first line
+%% will begin with the exact required reply code, followed
+%% immediately by a Hyphen, "-" (also known as Minus), followed by
+%% text. The last line will begin with the same code, followed
+%% immediately by Space <SP>, optionally some text, and the Telnet
+%% end-of-line code.
+%%
+%% For example:
+%% 123-First line
+%% Second line
+%% 234 A line beginning with numbers
+%% 123 The last line
+%%
+%% The user-process then simply needs to search for the second
+%% occurrence of the same reply code, followed by <SP> (Space), at
+%% the beginning of a line, and ignore all intermediary lines. If
+%% an intermediary line begins with a 3-digit number, the Server
+%% must pad the front to avoid confusion.
+%%
+%% This scheme allows standard system routines to be used for
+%% reply information (such as for the STAT reply), with
+%% "artificial" first and last lines tacked on. In rare cases
+%% where these routines are able to generate three digits and a
+%% Space at the beginning of any line, the beginning of each
+%% text line should be offset by some neutral text, like Space.
+%%
+%% This scheme assumes that multi-line replies may not be nested."
+
+%% We have to collect the stream of result characters into lines (ending
+%% in "\r\n"; we check for "\n"). When a line is assembled, left-over
+%% characters are saved in the process dictionary.
+%%
+
+%% result(Sock) = rescode()
+%%
+result(Sock) ->
+ result(Sock, false).
+
+result_line(Sock) ->
+ result(Sock, true).
+
+%% result(Sock, Bool) = {error,Reason} | rescode() | {rescode(), Lines}
+%% Printout if Bool = true.
+%%
+result(Sock, RetForm) ->
+ case getline(Sock) of
+ Line when length(Line) > 3 ->
+ [D1, D2, D3| Tail] = Line,
+ case Tail of
+ [$-| _] ->
+ parse_to_end(Sock, [D1, D2, D3, $ ]); % 3 digits + space
+ _ ->
+ ok
+ end,
+ result(D1,D2,D3,Line,RetForm);
+ _ ->
+ retform(rescode(?PERM_NEG_COMPL,-1,-1),[],RetForm)
+ end.
+
+result(D1,_D2,_D3,Line,_RetForm) when D1 - $0 > 10 ->
+ {error,{invalid_server_response,Line}};
+result(D1,_D2,_D3,Line,_RetForm) when D1 - $0 < 0 ->
+ {error,{invalid_server_response,Line}};
+result(D1,D2,D3,Line,RetForm) ->
+ Res1 = D1 - $0,
+ Res2 = D2 - $0,
+ Res3 = D3 - $0,
+ verbose(" ~w : ~s", [Res1, Line]),
+ retform(rescode(Res1,Res2,Res3),Line,RetForm).
+
+retform(ResCode,Line,true) ->
+ {ResCode,Line};
+retform(ResCode,_,_) ->
+ ResCode.
+
+leftovers() ->
+ case get(leftovers) of
+ undefined -> [];
+ X -> X
+ end.
+
+%% getline(Sock) = Line
+%%
+getline(Sock) ->
+ getline(Sock, leftovers()).
+
+getline(Sock, Rest) ->
+ getline1(Sock, split($\n, Rest), 0).
+
+getline1(Sock, {[], Rest}, ?OPER_TIMEOUT) ->
+ sock_close(Sock),
+ put(leftovers, Rest),
+ [];
+getline1(Sock, {[], Rest}, Retry) ->
+ case sock_read(Sock) of
+ {ok, More} ->
+ debug(" read : ~s~n",[More]),
+ getline(Sock, Rest ++ More);
+ {error, timeout} ->
+ %% Retry..
+ getline1(Sock, {[], Rest}, Retry+1);
+ Error ->
+ put(leftovers, Rest),
+ []
+ end;
+getline1(Sock, {Line, Rest}, Retry) ->
+ put(leftovers, Rest),
+ Line.
+
+parse_to_end(Sock, Prefix) ->
+ Line = getline(Sock),
+ case lists:prefix(Prefix, Line) of
+ false ->
+ parse_to_end(Sock, Prefix);
+ true ->
+ ok
+ end.
+
+
+%% Split list after first occurence of S.
+%% Returns {Prefix, Suffix} ({[], Cs} if S not found).
+split(S, Cs) ->
+ split(S, Cs, []).
+
+split(S, [S| Cs], As) ->
+ {lists:reverse([S|As]), Cs};
+split(S, [C| Cs], As) ->
+ split(S, Cs, [C| As]);
+split(_, [], As) ->
+ {[], lists:reverse(As)}.
+
+%%
+%% FILE INTERFACE
+%%
+%% All files are opened raw in binary mode.
+%%
+-define(BUFSIZE, 4096).
+
+file_open(File, Option) ->
+ file:open(File, [raw, binary, Option]).
+
+file_close(Fd) ->
+ file:close(Fd).
+
+
+file_read(Fd) -> % Compatible with pre R2A.
+ case file:read(Fd, ?BUFSIZE) of
+ {ok, {N, Bytes}} ->
+ {N, Bytes};
+ {ok, Bytes} ->
+ {size(Bytes), Bytes};
+ eof ->
+ {0, []}
+ end.
+
+file_write(Fd, Bytes) ->
+ file:write(Fd, Bytes).
+
+absname(Dir, File) -> % Args swapped.
+ filename:absname(File, Dir).
+
+
+
+%% sock_start()
+%%
+
+%%
+%% USE GEN_TCP
+%%
+
+sock_start() ->
+ inet_db:start().
+
+%%
+%% Connect to FTP server at Host (default is TCP port 21) in raw mode,
+%% in order to establish a control connection.
+%%
+
+sock_connect(Host,Port,TimeOut) ->
+ debug(" info : connect to server on ~p:~p~n",[Host,Port]),
+ Opts = [{packet, 0}, {active, false}],
+ case (catch gen_tcp:connect(Host, Port, Opts,TimeOut)) of
+ {'EXIT', R1} -> % XXX Probably no longer needed.
+ debug(" error: socket connectionn failed with exit reason:"
+ "~n ~p",[R1]),
+ {error, ehost};
+ {error, R2} ->
+ debug(" error: socket connectionn failed with exit reason:"
+ "~n ~p",[R2]),
+ {error, ehost};
+ {ok, Sock} ->
+ Sock
+ end.
+
+%%
+%% Create a listen socket (any port) in binary or raw non-packet mode for
+%% data connection.
+%%
+sock_listen(Mode, IP) ->
+ Opts = case Mode of
+ binary ->
+ [binary, {packet, 0}];
+ raw ->
+ [{packet, 0}]
+ end,
+ {ok, Sock} = gen_tcp:listen(0, [{ip, IP}, {active, false} | Opts]),
+ Sock.
+
+sock_accept(LSock) ->
+ {ok, Sock} = gen_tcp:accept(LSock),
+ Sock.
+
+sock_close(undefined) ->
+ ok;
+sock_close(Sock) ->
+ gen_tcp:close(Sock).
+
+sock_read(Sock) ->
+ case gen_tcp:recv(Sock, 0, ?BYTE_TIMEOUT) of
+ {ok, Bytes} ->
+ {ok, Bytes};
+
+ {error, closed} ->
+ {closed, closed}; % Yes
+
+ %% --- OTP-4770 begin ---
+ %%
+ %% This seems to happen on windows
+ %% "Someone" tried to close an already closed socket...
+ %%
+
+ {error, enotsock} ->
+ {closed, enotsock};
+
+ %%
+ %% --- OTP-4770 end ---
+
+ {error, etimedout} ->
+ {error, timeout};
+
+ Other ->
+ Other
+ end.
+
+%% receive
+%% {tcp, Sock, Bytes} ->
+%% {ok, Bytes};
+%% {tcp_closed, Sock} ->
+%% {closed, closed}
+%% end.
+
+sock_write(Sock, Bytes) ->
+ gen_tcp:send(Sock, Bytes).
+
+sock_name(Sock) ->
+ {ok, {IP, Port}} = inet:sockname(Sock),
+ {IP, Port}.
+
+sock_listen_port(LSock) ->
+ {ok, Port} = inet:port(LSock),
+ Port.
+
+
+%%
+%% ERROR STRINGS
+%%
+errstr({error, Reason}) ->
+ errstr(Reason);
+
+errstr(echunk) -> "Synchronisation error during chung sending.";
+errstr(eclosed) -> "Session has been closed.";
+errstr(econn) -> "Connection to remote server prematurely closed.";
+errstr(eexists) ->"File or directory already exists.";
+errstr(ehost) -> "Host not found, FTP server not found, "
+"or connection rejected.";
+errstr(elogin) -> "User not logged in.";
+errstr(enotbinary) -> "Term is not a binary.";
+errstr(epath) -> "No such file or directory, already exists, "
+"or permission denied.";
+errstr(etype) -> "No such type.";
+errstr(euser) -> "User name or password not valid.";
+errstr(etnospc) -> "Insufficient storage space in system.";
+errstr(epnospc) -> "Exceeded storage allocation "
+"(for current directory or dataset).";
+errstr(efnamena) -> "File name not allowed.";
+errstr(Reason) ->
+ lists:flatten(io_lib:format("Unknown error: ~w", [Reason])).
+
+
+
+%% ----------------------------------------------------------
+
+get_verbose(Params) -> check_param(verbose,Params).
+
+get_debug(Flags) -> check_param(debug,Flags).
+
+check_param(P,Ps) -> lists:member(P,Ps).
+
+
+%% verbose -> ok
+%%
+%% Prints the string if the Flags list is non-epmty
+%%
+%% Params: F Format string
+%% A Arguments to the format string
+%%
+verbose(F,A) -> verbose(get(verbose),F,A).
+
+verbose(true,F,A) -> print(F,A);
+verbose(_,_F,_A) -> ok.
+
+
+
+
+%% debug -> ok
+%%
+%% Prints the string if debug enabled
+%%
+%% Params: F Format string
+%% A Arguments to the format string
+%%
+debug(F,A) -> debug(get(debug),F,A).
+
+debug(true,F,A) -> print(F,A);
+debug(_,_F,_A) -> ok.
+
+
+print(F,A) -> io:format(F,A).
+
+
+
+transfer_file(Cmd,LFile,RFile,State)->
+ #state{csock = CSock, ldir = LDir} = State,
+ ARFile = case RFile of
+ "" ->
+ LFile;
+ _ ->
+ RFile
+ end,
+ ALFile = absname(LDir, LFile),
+ case file_open(ALFile, read) of
+ {ok, Fd} ->
+ LSock = listen_data(CSock, binary),
+ case ctrl_cmd(CSock, "~s ~s", [Cmd,ARFile]) of
+ pos_prel ->
+ DSock = accept_data(LSock),
+ SFreply = send_file(Fd, DSock),
+ file_close(Fd),
+ sock_close(DSock),
+ case {SFreply,result(CSock)} of
+ {ok,pos_compl} ->
+ {reply, ok, State};
+ {ok,Other} ->
+ debug(" error: unknown reply: ~p~n",[Other]),
+ {reply, {error, epath}, State};
+ {{error,Why},Result} ->
+ ?STOP_RET(retcode(Result,econn))
+ end;
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ Other ->
+ debug(" error: ctrl failed: ~p~n",[Other]),
+ {reply, {error, epath}, State}
+ end;
+ {error, Reason} ->
+ debug(" error: file open: ~p~n",[Reason]),
+ {reply, {error, epath}, State}
+ end.
+
+transfer_data(Cmd,Bin,RFile,State)->
+ #state{csock = CSock, ldir = LDir} = State,
+ LSock = listen_data(CSock, binary),
+ case ctrl_cmd(CSock, "~s ~s", [Cmd,RFile]) of
+ pos_prel ->
+ DSock = accept_data(LSock),
+ SReply = sock_write(DSock, Bin),
+ sock_close(DSock),
+ case {SReply,result(CSock)} of
+ {ok,pos_compl} ->
+ {reply, ok, State};
+ {ok,trans_no_space} ->
+ ?STOP_RET(etnospc);
+ {ok,perm_no_space} ->
+ ?STOP_RET(epnospc);
+ {ok,perm_fname_not_allowed} ->
+ ?STOP_RET(efnamena);
+ {ok,Other} ->
+ debug(" error: unknown reply: ~p~n",[Other]),
+ {reply, {error, epath}, State};
+ {{error,Why},Result} ->
+ ?STOP_RET(retcode(Result,econn))
+ %% {{error,_Why},_Result} ->
+ %% ?STOP_RET(econn)
+ end;
+
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+
+ Other ->
+ debug(" error: ctrl failed: ~p~n",[Other]),
+ {reply, {error, epath}, State}
+ end.
+
+
+start_chunk_transfer(Cmd, RFile, #state{csock = CSock} = State) ->
+ LSock = listen_data(CSock, binary),
+ case ctrl_cmd(CSock, "~s ~s", [Cmd,RFile]) of
+ pos_prel ->
+ DSock = accept_data(LSock),
+ {reply, ok, State#state{dsock = DSock, chunk = true}};
+ {error, enotconn} ->
+ ?STOP_RET(econn);
+ Otherwise ->
+ debug(" error: ctrl failed: ~p~n",[Otherwise]),
+ {reply, {error, epath}, State}
+ end.
+
+
+chunk_transfer(Bin,State)->
+ #state{dsock = DSock, csock = CSock} = State,
+ case DSock of
+ undefined ->
+ {reply,{error,econn},State};
+ _ ->
+ case sock_write(DSock, Bin) of
+ ok ->
+ {reply, ok, State};
+ Other ->
+ debug(" error: chunk write error: ~p~n",[Other]),
+ {reply, {error, econn}, State#state{dsock = undefined}}
+ end
+ end.
+
+
+
+end_chunk_transfer(State)->
+ #state{csock = CSock, dsock = DSock} = State,
+ case DSock of
+ undefined ->
+ Result = result(CSock),
+ case Result of
+ pos_compl ->
+ {reply,ok,State#state{dsock = undefined,
+ chunk = false}};
+ trans_no_space ->
+ ?STOP_RET(etnospc);
+ perm_no_space ->
+ ?STOP_RET(epnospc);
+ perm_fname_not_allowed ->
+ ?STOP_RET(efnamena);
+ Result ->
+ debug(" error: send chunk end (1): ~p~n",
+ [Result]),
+ {reply,{error,epath},State#state{dsock = undefined,
+ chunk = false}}
+ end;
+ _ ->
+ sock_close(DSock),
+ Result = result(CSock),
+ case Result of
+ pos_compl ->
+ {reply,ok,State#state{dsock = undefined,
+ chunk = false}};
+ trans_no_space ->
+ sock_close(CSock),
+ ?STOP_RET(etnospc);
+ perm_no_space ->
+ sock_close(CSock),
+ ?STOP_RET(epnospc);
+ perm_fname_not_allowed ->
+ sock_close(CSock),
+ ?STOP_RET(efnamena);
+ Result ->
+ debug(" error: send chunk end (2): ~p~n",
+ [Result]),
+ {reply,{error,epath},State#state{dsock = undefined,
+ chunk = false}}
+ end
+ end.
+
+get_key1(Key,List,Default)->
+ case lists:keysearch(Key,1,List)of
+ {value,{_,Val}}->
+ Val;
+ false->
+ Default
+ end.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.erl
new file mode 100644
index 0000000000..764e7fb092
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.erl
@@ -0,0 +1,260 @@
+%% ``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 Mobile Arts AB
+%% Portions created by Mobile Arts are Copyright 2002, Mobile Arts AB
+%% All Rights Reserved.''
+%%
+%%
+
+%%% This version of the HTTP/1.1 client implements:
+%%% - RFC 2616 HTTP 1.1 client part
+%%% - RFC 2817 Upgrading to TLS Within HTTP/1.1 (not yet!)
+%%% - RFC 2818 HTTP Over TLS
+%%% - RFC 3229 Delta encoding in HTTP (not yet!)
+%%% - RFC 3230 Instance Digests in HTTP (not yet!)
+%%% - RFC 3310 Authentication and Key Agreement (AKA) (not yet!)
+%%% - HTTP/1.1 Specification Errata found at
+%%% http://world.std.com/~lawrence/http_errata.html
+%%% Additionaly follows the following recommendations:
+%%% - RFC 3143 Known HTTP Proxy/Caching Problems (not yet!)
+%%% - draft-nottingham-hdrreg-http-00.txt (not yet!)
+%%%
+%%% Depends on
+%%% - uri.erl for all URL parsing (except what is handled by the C driver)
+%%% - http_lib.erl for all parsing of body and headers
+%%%
+%%% Supported Settings are:
+%%% http_timeout % (int) Milliseconds before a request times out
+%%% http_useproxy % (bool) True if a proxy should be used
+%%% http_proxy % (string) Proxy
+%%% http_noproxylist % (list) List with hosts not requiring proxy
+%%% http_autoredirect % (bool) True if automatic redirection on 30X responses
+%%% http_ssl % (list) SSL settings. A non-empty list enables SSL/TLS
+%%% support in the HTTP client
+%%% http_pipelinesize % (int) Length of pipeline. 1 means no pipeline.
+%%% Only has effect when initiating a new session.
+%%% http_sessions % (int) Max number of open sessions for {Addr,Port}
+%%%
+%%% TODO: (Known bugs!)
+%% - Cache handling
+%% - Doesn't handle a bunch of entity headers properly
+%% - Better handling of status codes different from 200,30X and 50X
+%% - Many of the settings above are not implemented!
+%% - close_session/2 and cancel_request/1 doesn't work
+%% - Variable pipe size.
+%% - Due to the fact that inet_drv only has a single timer, the timeouts given
+%% for pipelined requests are not ok (too long)
+%%
+%% Note:
+%% - Some servers (e.g. Microsoft-IIS/5.0) may sometimes not return a proper
+%% 'Location' header on a redirect.
+%% The client will fail with {error,no_scheme} in these cases.
+
+-module(http).
+-author("[email protected]").
+
+-export([start/0,
+ request/3,request/4,cancel_request/1,
+ request_sync/2,request_sync/3]).
+
+-include("http.hrl").
+-include("jnets_httpd.hrl").
+
+-define(START_OPTIONS,[]).
+
+%%% HTTP Client manager. Used to store open connections.
+%%% Will be started automatically unless started explicitly.
+start() ->
+ application:start(ssl),
+ httpc_manager:start().
+
+%%% Asynchronous HTTP request that spawns a handler.
+%%% Method HTTPReq
+%%% options,get,head,delete,trace = {Url,Headers}
+%%% post,put = {Url,Headers,ContentType,Body}
+%%% where Url is a {Scheme,Host,Port,PathQuery} tuple, as returned by uri.erl
+%%%
+%%% Returns: {ok,ReqId} |
+%%% {error,Reason}
+%%% If {ok,Pid} was returned, the handler will return with
+%%% gen_server:cast(From,{Ref,ReqId,{error,Reason}}) |
+%%% gen_server:cast(From,{Ref,ReqId,{Status,Headers,Body}})
+%%% where Reason is an atom and Headers a #res_headers{} record
+%%% http:format_error(Reason) gives a more informative description.
+%%%
+%%% Note:
+%%% - Always try to find an open connection to a given host and port, and use
+%%% the associated socket.
+%%% - Unless a 'Connection: close' header is provided don't close the socket
+%%% after a response is given
+%%% - A given Pid, found in the database, might be terminated before the
+%%% message is sent to the Pid. This will happen e.g., if the connection is
+%%% closed by the other party and there are no pending requests.
+%%% - The HTTP connection process is spawned, if necessary, in
+%%% httpc_manager:add_connection/4
+request(Ref,Method,HTTPReqCont) ->
+ request(Ref,Method,HTTPReqCont,[],self()).
+
+request(Ref,Method,HTTPReqCont,Settings) ->
+ request(Ref,Method,HTTPReqCont,Settings,self()).
+
+request(Ref,Method,{{Scheme,Host,Port,PathQuery},
+ Headers,ContentType,Body},Settings,From) ->
+ case create_settings(Settings,#client_settings{}) of
+ {error,Reason} ->
+ {error,Reason};
+ CS ->
+ case create_headers(Headers,#req_headers{}) of
+ {error,Reason} ->
+ {error,Reason};
+ H ->
+ Req=#request{ref=Ref,from=From,
+ scheme=Scheme,address={Host,Port},
+ pathquery=PathQuery,method=Method,
+ headers=H,content={ContentType,Body},
+ settings=CS},
+ httpc_manager:request(Req)
+ end
+ end;
+request(Ref,Method,{Url,Headers},Settings,From) ->
+ request(Ref,Method,{Url,Headers,[],[]},Settings,From).
+
+%%% Cancels requests identified with ReqId.
+%%% FIXME! Doesn't work...
+cancel_request(ReqId) ->
+ httpc_manager:cancel_request(ReqId).
+
+%%% Close all sessions currently open to Host:Port
+%%% FIXME! Doesn't work...
+close_session(Host,Port) ->
+ httpc_manager:close_session(Host,Port).
+
+
+%%% Synchronous HTTP request that waits until a response is created
+%%% (e.g. successfull reply or timeout)
+%%% Method HTTPReq
+%%% options,get,head,delete,trace = {Url,Headers}
+%%% post,put = {Url,Headers,ContentType,Body}
+%%% where Url is a string() or a {Scheme,Host,Port,PathQuery} tuple
+%%%
+%%% Returns: {Status,Headers,Body} |
+%%% {error,Reason}
+%%% where Reason is an atom.
+%%% http:format_error(Reason) gives a more informative description.
+request_sync(Method,HTTPReqCont) ->
+ request_sync(Method,HTTPReqCont,[]).
+
+request_sync(Method,{Url,Headers},Settings)
+ when Method==options;Method==get;Method==head;Method==delete;Method==trace ->
+ case uri:parse(Url) of
+ {error,Reason} ->
+ {error,Reason};
+ ParsedUrl ->
+ request_sync(Method,{ParsedUrl,Headers,[],[]},Settings,0)
+ end;
+request_sync(Method,{Url,Headers,ContentType,Body},Settings)
+ when Method==post;Method==put ->
+ case uri:parse(Url) of
+ {error,Reason} ->
+ {error,Reason};
+ ParsedUrl ->
+ request_sync(Method,{ParsedUrl,Headers,ContentType,Body},Settings,0)
+ end;
+request_sync(Method,Request,Settings) ->
+ {error,bad_request}.
+
+request_sync(Method,HTTPCont,Settings,_Redirects) ->
+ case request(request_sync,Method,HTTPCont,Settings,self()) of
+ {ok,_ReqId} ->
+ receive
+ {'$gen_cast',{request_sync,_ReqId2,{Status,Headers,Body}}} ->
+ {Status,pp_headers(Headers),binary_to_list(Body)};
+ {'$gen_cast',{request_sync,_ReqId2,{error,Reason}}} ->
+ {error,Reason};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+
+create_settings([],Out) ->
+ Out;
+create_settings([{http_timeout,Val}|Settings],Out) ->
+ create_settings(Settings,Out#client_settings{timeout=Val});
+create_settings([{http_useproxy,Val}|Settings],Out) ->
+ create_settings(Settings,Out#client_settings{useproxy=Val});
+create_settings([{http_proxy,Val}|Settings],Out) ->
+ create_settings(Settings,Out#client_settings{proxy=Val});
+create_settings([{http_noproxylist,Val}|Settings],Out) ->
+ create_settings(Settings,Out#client_settings{noproxylist=Val});
+create_settings([{http_autoredirect,Val}|Settings],Out) ->
+ create_settings(Settings,Out#client_settings{autoredirect=Val});
+create_settings([{http_ssl,Val}|Settings],Out) ->
+ create_settings(Settings,Out#client_settings{ssl=Val});
+create_settings([{http_pipelinesize,Val}|Settings],Out)
+ when integer(Val),Val>0 ->
+ create_settings(Settings,Out#client_settings{max_quelength=Val});
+create_settings([{http_sessions,Val}|Settings],Out)
+ when integer(Val),Val>0 ->
+ create_settings(Settings,Out#client_settings{max_sessions=Val});
+create_settings([{Key,_Val}|_Settings],_Out) ->
+ io:format("ERROR bad settings, got ~p~n",[Key]),
+ {error,bad_settings}.
+
+
+create_headers([],Req) ->
+ Req;
+create_headers([{Key,Val}|Rest],Req) ->
+ case httpd_util:to_lower(Key) of
+ "expect" ->
+ create_headers(Rest,Req#req_headers{expect=Val});
+ OtherKey ->
+ create_headers(Rest,
+ Req#req_headers{other=[{OtherKey,Val}|
+ Req#req_headers.other]})
+ end.
+
+
+pp_headers(#res_headers{connection=Connection,
+ transfer_encoding=Transfer_encoding,
+ retry_after=Retry_after,
+ content_length=Content_length,
+ content_type=Content_type,
+ location=Location,
+ other=Other}) ->
+ H1=case Connection of
+ undefined -> [];
+ _ -> [{'Connection',Connection}]
+ end,
+ H2=case Transfer_encoding of
+ undefined -> [];
+ _ -> [{'Transfer-Encoding',Transfer_encoding}]
+ end,
+ H3=case Retry_after of
+ undefined -> [];
+ _ -> [{'Retry-After',Retry_after}]
+ end,
+ H4=case Location of
+ undefined -> [];
+ _ -> [{'Location',Location}]
+ end,
+ HCL=case Content_length of
+ "0" -> [];
+ _ -> [{'Content-Length',Content_length}]
+ end,
+ HCT=case Content_type of
+ undefined -> [];
+ _ -> [{'Content-Type',Content_type}]
+ end,
+ H1++H2++H3++H4++HCL++HCT++Other.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.hrl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.hrl
new file mode 100644
index 0000000000..f10ca47a9a
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.hrl
@@ -0,0 +1,127 @@
+%% ``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 Mobile Arts AB
+%% Portions created by Mobile Arts are Copyright 2002, Mobile Arts AB
+%% All Rights Reserved.''
+%%
+%%
+
+-define(HTTP_REQUEST_TIMEOUT, 5000).
+-define(PIPELINE_LENGTH,3).
+-define(OPEN_SESSIONS,400).
+
+
+%%% FIXME! These definitions should probably be possible to defined via
+%%% user settings
+-define(MAX_REDIRECTS, 4).
+
+
+%%% Note that if not persitent the connection can be closed immediately on a
+%%% response, because new requests are not sent to this connection process.
+%%% address, % ({Host,Port}) Destination Host and Port
+-record(session,{
+ id, % (int) Session Id identifies session in http_manager
+ clientclose, % (bool) true if client requested "close" connection
+ scheme, % (atom) http (HTTP/TCP) or https (TCP/SSL/TCP)
+ socket, % (socket) Open socket, used by connection
+ pipeline=[], % (list) Sent requests, not yet taken care of by the
+ % associated http_responder.
+ quelength=1, % (int) Current length of pipeline (1 when created)
+ max_quelength% (int) Max pipeline length
+ }).
+
+%%% [{Pid,RequestQue,QueLength},...] list where
+%%% - RequestQue (implemented with a list) contains sent requests that
+%%% has not yet received a response (pipelined) AND is not currently
+%%% handled (awaiting data) by the session process.
+%%% - QueLength is the length of this que, but
+
+%%% Response headers
+-record(res_headers,{
+%%% --- Standard "General" headers
+% cache_control,
+ connection,
+% date,
+% pragma,
+% trailer,
+ transfer_encoding,
+% upgrade,
+% via,
+% warning,
+%%% --- Standard "Request" headers
+% accept_ranges,
+% age,
+% etag,
+ location,
+% proxy_authenticate,
+ retry_after,
+% server,
+% vary,
+% www_authenticate,
+%%% --- Standard "Entity" headers
+% allow,
+% content_encoding,
+% content_language,
+ content_length="0",
+% content_location,
+% content_md5,
+% content_range,
+ content_type,
+% expires,
+% last_modified,
+ other=[] % (list) Key/Value list with other headers
+ }).
+
+%%% All data associated to a specific HTTP request
+-record(request,{
+ id, % (int) Request Id
+ ref, % Caller specific
+ from, % (pid) Caller
+ redircount=0,% (int) Number of redirects made for this request
+ scheme, % (http|https) (HTTP/TCP) or (TCP/SSL/TCP) connection
+ address, % ({Host,Port}) Destination Host and Port
+ pathquery, % (string) Rest of parsed URL
+ method, % (atom) HTTP request Method
+ headers, % (list) Key/Value list with Headers
+ content, % ({ContentType,Body}) Current HTTP request
+ settings % (#client_settings{}) User defined settings
+ }).
+
+-record(response,{
+ scheme, % (atom) http (HTTP/TCP) or https (TCP/SSL/TCP)
+ socket, % (socket) Open socket, used by connection
+ status,
+ http_version,
+ headers=#res_headers{},
+ body = <<>>
+ }).
+
+
+
+
+%%% HTTP Client settings
+-record(client_settings,{
+ timeout=?HTTP_REQUEST_TIMEOUT,
+ % (int) Milliseconds before a request times out
+ useproxy=false, % (bool) True if the proxy should be used
+ proxy=undefined, % (tuple) Parsed Proxy URL
+ noproxylist=[], % (list) List with hosts not requiring proxy
+ autoredirect=true, % (bool) True if automatic redirection on 30X
+ % responses.
+ max_sessions=?OPEN_SESSIONS,% (int) Max open sessions for any Adr,Port
+ max_quelength=?PIPELINE_LENGTH, % (int) Max pipeline length
+% ssl=[{certfile,"/jb/server_root/ssl/ssl_client.pem"},
+% {keyfile,"/jb/server_root/ssl/ssl_client.pem"},
+% {verify,0}]
+ ssl=false % (list) SSL settings. A non-empty list enables SSL/TLS
+ % support in the HTTP client
+ }).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http_lib.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http_lib.erl
new file mode 100644
index 0000000000..eb8d7d66b1
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http_lib.erl
@@ -0,0 +1,745 @@
+%% ``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 Mobile Arts AB
+%% Portions created by Mobile Arts are Copyright 2002, Mobile Arts AB
+%% All Rights Reserved.''
+%%
+%%
+%%% File : http_lib.erl
+%%% Author : Johan Blom <[email protected]>
+%%% Description : Generic, HTTP specific helper functions
+%%% Created : 4 Mar 2002 by Johan Blom
+
+%%% TODO
+%%% - Check if I need to anything special when parsing
+%%% "Content-Type:multipart/form-data"
+
+-module(http_lib).
+-author("[email protected]").
+
+-include("http.hrl").
+-include("jnets_httpd.hrl").
+
+-export([connection_close/1,
+ accept/3,deliver/3,recv/4,recv0/3,
+ connect/1,send/3,close/2,controlling_process/3,setopts/3,
+ getParameterValue/2,
+% get_var/2,
+ create_request_line/3]).
+
+-export([read_client_headers/2,read_server_headers/2,
+ get_auth_data/1,create_header_list/1,
+ read_client_body/2,read_client_multipartrange_body/3,
+ read_server_body/2]).
+
+
+%%% Server response:
+%%% Check "Connection" header if server requests session to be closed.
+%%% No 'close' means returns false
+%%% Client Request:
+%%% Check if 'close' in request headers
+%%% Only care about HTTP 1.1 clients!
+connection_close(Headers) when record(Headers,req_headers) ->
+ case Headers#req_headers.connection of
+ "close" ->
+ true;
+ "keep-alive" ->
+ false;
+ Value when list(Value) ->
+ true;
+ _ ->
+ false
+ end;
+connection_close(Headers) when record(Headers,res_headers) ->
+ case Headers#res_headers.connection of
+ "close" ->
+ true;
+ "keep-alive" ->
+ false;
+ Value when list(Value) ->
+ true;
+ _ ->
+ false
+ end.
+
+
+%% =============================================================================
+%%% Debugging:
+
+% format_time(TS) ->
+% {_,_,MicroSecs}=TS,
+% {{Y,Mon,D},{H,M,S}}=calendar:now_to_universal_time(TS),
+% lists:flatten(io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w,~2.2.0w:~2.2.0w:~6.3.0f",
+% [Y,Mon,D,H,M,S+(MicroSecs/1000000)])).
+
+%% Time in milli seconds
+% t() ->
+% {A,B,C} = erlang:now(),
+% A*1000000000+B*1000+(C div 1000).
+
+% sz(L) when list(L) ->
+% length(L);
+% sz(B) when binary(B) ->
+% size(B);
+% sz(O) ->
+% {unknown_size,O}.
+
+
+%% =============================================================================
+
+getHeaderValue(_Attr,[]) ->
+ [];
+getHeaderValue(Attr,[{Attr,Value}|_Rest]) ->
+ Value;
+getHeaderValue(Attr,[_|Rest]) ->
+ getHeaderValue(Attr,Rest).
+
+getParameterValue(_Attr,undefined) ->
+ undefined;
+getParameterValue(Attr,List) ->
+ case lists:keysearch(Attr,1,List) of
+ {value,{Attr,Val}} ->
+ Val;
+ _ ->
+ undefined
+ end.
+
+create_request_line(Method,Path,{Major,Minor}) ->
+ [atom_to_list(Method)," ",Path,
+ " HTTP/",integer_to_list(Major),".",integer_to_list(Minor)];
+create_request_line(Method,Path,Minor) ->
+ [atom_to_list(Method)," ",Path," HTTP/1.",integer_to_list(Minor)].
+
+
+%%% ============================================================================
+read_client_headers(Info,Timeout) ->
+ Headers=read_response_h(Info#response.scheme,Info#response.socket,Timeout,
+ Info#response.headers),
+ Info#response{headers=Headers}.
+
+read_server_headers(Info,Timeout) ->
+ Headers=read_request_h(Info#mod.socket_type,Info#mod.socket,Timeout,
+ Info#mod.headers),
+ Info#mod{headers=Headers}.
+
+
+%% Parses the header of a HTTP request and returns a key,value tuple
+%% list containing Name and Value of each header directive as of:
+%%
+%% Content-Type: multipart/mixed -> {"Content-Type", "multipart/mixed"}
+%%
+%% But in http/1.1 the field-names are case insencitive so now it must be
+%% Content-Type: multipart/mixed -> {"content-type", "multipart/mixed"}
+%% The standard furthermore says that leading and traling white space
+%% is not a part of the fieldvalue and shall therefore be removed.
+read_request_h(SType,S,Timeout,H) ->
+ case recv0(SType,S,Timeout) of
+ {ok,{http_header,_,'Connection',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{connection=Value});
+ {ok,{http_header,_,'Content-Type',_,Val}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{content_type=Val});
+ {ok,{http_header,_,'Host',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{host=Value});
+ {ok,{http_header,_,'Content-Length',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{content_length=Value});
+% {ok,{http_header,_,'Expect',_,Value}} -> % FIXME! Update inet_drv.c!!
+% read_request_h(SType,S,Timeout,H#req_headers{expect=Value});
+ {ok,{http_header,_,'Transfer-Encoding',_,V}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{transfer_encoding=V});
+ {ok,{http_header,_,'Authorization',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{authorization=Value});
+ {ok,{http_header,_,'User-Agent',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{user_agent=Value});
+ {ok,{http_header,_,'Range',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{range=Value});
+ {ok,{http_header,_,'If-Range',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{if_range=Value});
+ {ok,{http_header,_,'If-Match',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{if_match=Value});
+ {ok,{http_header,_,'If-None-Match',_,Value}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{if_none_match=Value});
+ {ok,{http_header,_,'If-Modified-Since',_,V}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{if_modified_since=V});
+ {ok,{http_header,_,'If-Unmodified-Since',_,V}} ->
+ read_request_h(SType,S,Timeout,H#req_headers{if_unmodified_since=V});
+ {ok,{http_header,_,K,_,V}} ->
+ read_request_h(SType,S,Timeout,
+ H#req_headers{other=H#req_headers.other++[{K,V}]});
+ {ok,http_eoh} ->
+ H;
+ {error, timeout} when SType==http ->
+ throw({error, session_local_timeout});
+ {error, etimedout} when SType==https ->
+ throw({error, session_local_timeout});
+ {error, Reason} when Reason==closed;Reason==enotconn ->
+ throw({error, session_remotely_closed});
+ {error, Reason} ->
+ throw({error,Reason})
+ end.
+
+
+read_response_h(SType,S,Timeout,H) ->
+ case recv0(SType,S,Timeout) of
+ {ok,{http_header,_,'Connection',_,Val}} ->
+ read_response_h(SType,S,Timeout,H#res_headers{connection=Val});
+ {ok,{http_header,_,'Content-Length',_,Val}} ->
+ read_response_h(SType,S,Timeout,H#res_headers{content_length=Val});
+ {ok,{http_header,_,'Content-Type',_,Val}} ->
+ read_response_h(SType,S,Timeout,H#res_headers{content_type=Val});
+ {ok,{http_header,_,'Transfer-Encoding',_,V}} ->
+ read_response_h(SType,S,Timeout,H#res_headers{transfer_encoding=V});
+ {ok,{http_header,_,'Location',_,V}} ->
+ read_response_h(SType,S,Timeout,H#res_headers{location=V});
+ {ok,{http_header,_,'Retry-After',_,V}} ->
+ read_response_h(SType,S,Timeout,H#res_headers{retry_after=V});
+ {ok,{http_header,_,K,_,V}} ->
+ read_response_h(SType,S,Timeout,
+ H#res_headers{other=H#res_headers.other++[{K,V}]});
+ {ok,http_eoh} ->
+ H;
+ {error, timeout} when SType==http ->
+ throw({error, session_local_timeout});
+ {error, etimedout} when SType==https ->
+ throw({error, session_local_timeout});
+ {error, Reason} when Reason==closed;Reason==enotconn ->
+ throw({error, session_remotely_closed});
+ {error, Reason} ->
+ throw({error,Reason})
+ end.
+
+
+%%% Got the headers, and maybe a part of the body, now read in the rest
+%%% Note:
+%%% - No need to check for Expect header if client
+%%% - Currently no support for setting MaxHeaderSize in client, set to
+%%% unlimited.
+%%% - Move to raw packet mode as we are finished with HTTP parsing
+read_client_body(Info,Timeout) ->
+ Headers=Info#response.headers,
+ case Headers#res_headers.transfer_encoding of
+ "chunked" ->
+ ?DEBUG("read_entity_body2()->"
+ "Transfer-encoding:Chunked Data:",[]),
+ read_client_chunked_body(Info,Timeout,?MAXBODYSIZE);
+ Encoding when list(Encoding) ->
+ ?DEBUG("read_entity_body2()->"
+ "Transfer-encoding:Unknown",[]),
+ throw({error,unknown_coding});
+ _ ->
+ ContLen=list_to_integer(Headers#res_headers.content_length),
+ if
+ ContLen>?MAXBODYSIZE ->
+ throw({error,body_too_big});
+ true ->
+ ?DEBUG("read_entity_body2()->"
+ "Transfer-encoding:none ",[]),
+ Info#response{body=read_plain_body(Info#response.scheme,
+ Info#response.socket,
+ ContLen,
+ Info#response.body,
+ Timeout)}
+ end
+ end.
+
+
+%%% ----------------------------------------------------------------------
+read_server_body(Info,Timeout) ->
+ MaxBodySz=httpd_util:lookup(Info#mod.config_db,max_body_size,?MAXBODYSIZE),
+ ContLen=list_to_integer((Info#mod.headers)#req_headers.content_length),
+ %% ?vtrace("ContentLength: ~p", [ContLen]),
+ if
+ integer(ContLen),integer(MaxBodySz),ContLen>MaxBodySz ->
+ throw({error,body_too_big});
+ true ->
+ read_server_body2(Info,Timeout,ContLen,MaxBodySz)
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Control if the body is transfer encoded, if so decode it.
+%% Note:
+%% - MaxBodySz has an integer value or 'nolimit'
+%% - ContLen has an integer value or 'undefined'
+%% All applications MUST be able to receive and decode the "chunked"
+%% transfer-coding, see RFC 2616 Section 3.6.1
+read_server_body2(Info,Timeout,ContLen,MaxBodySz) ->
+ ?DEBUG("read_entity_body2()->Max: ~p ~nLength:~p ~nSocket: ~p ~n",
+ [MaxBodySz,ContLen,Info#mod.socket]),
+ case (Info#mod.headers)#req_headers.transfer_encoding of
+ "chunked" ->
+ ?DEBUG("read_entity_body2()->"
+ "Transfer-encoding:Chunked Data:",[]),
+ read_server_chunked_body(Info,Timeout,MaxBodySz);
+ Encoding when list(Encoding) ->
+ ?DEBUG("read_entity_body2()->"
+ "Transfer-encoding:Unknown",[]),
+ httpd_response:send_status(Info,501,"Unknown Transfer-Encoding"),
+ http_lib:close(Info#mod.socket_type,Info#mod.socket),
+ throw({error,{status_sent,"Unknown Transfer-Encoding "++Encoding}});
+ _ when integer(ContLen),integer(MaxBodySz),ContLen>MaxBodySz ->
+ throw({error,body_too_big});
+ _ when integer(ContLen) ->
+ ?DEBUG("read_entity_body2()->"
+ "Transfer-encoding:none ",[]),
+ Info#mod{entity_body=read_plain_body(Info#mod.socket_type,
+ Info#mod.socket,
+ ContLen,Info#mod.entity_body,
+ Timeout)}
+ end.
+
+
+%%% ----------------------------------------------------------------------------
+%%% The body was plain, just read it from the socket.
+read_plain_body(_SocketType,Socket,0,Cont,_Timeout) ->
+ Cont;
+read_plain_body(SocketType,Socket,ContLen,Cont,Timeout) ->
+ Body=read_more_data(SocketType,Socket,ContLen,Timeout),
+ <<Cont/binary,Body/binary>>.
+
+%%% ----------------------------------------------------------------------------
+%%% The body was chunked, decode it.
+%%% From RFC2616, Section 3.6.1
+%% Chunked-Body = *chunk
+%% last-chunk
+%% trailer
+%% CRLF
+%%
+%% chunk = chunk-size [ chunk-extension ] CRLF
+%% chunk-data CRLF
+%% chunk-size = 1*HEX
+%% last-chunk = 1*("0") [ chunk-extension ] CRLF
+%%
+%% chunk-extension= *( ";" chunk-ext-name [ "=" chunk-ext-val ] )
+%% chunk-ext-name = token
+%% chunk-ext-val = token | quoted-string
+%% chunk-data = chunk-size(OCTET)
+%% trailer = *(entity-header CRLF)
+%%
+%%% "All applications MUST ignore chunk-extension extensions they do not
+%%% understand.", see RFC 2616 Section 3.6.1
+%%% We don't understand any extension...
+read_client_chunked_body(Info,Timeout,MaxChunkSz) ->
+ case read_chunk(Info#response.scheme,Info#response.socket,
+ Timeout,0,MaxChunkSz) of
+ {last_chunk,_ExtensionList} -> % Ignore extension
+ TrailH=read_headers_old(Info#response.scheme,Info#response.socket,
+ Timeout),
+ H=Info#response.headers,
+ OtherHeaders=H#res_headers.other++TrailH,
+ Info#response{headers=H#res_headers{other=OtherHeaders}};
+ {Chunk,ChunkSize,_ExtensionList} -> % Ignore extension
+ Info1=Info#response{body= <<(Info#response.body)/binary,
+ Chunk/binary>>},
+ read_client_chunked_body(Info1,Timeout,MaxChunkSz-ChunkSize);
+ {error,Reason} ->
+ throw({error,Reason})
+ end.
+
+
+read_server_chunked_body(Info,Timeout,MaxChunkSz) ->
+ case read_chunk(Info#mod.socket_type,Info#mod.socket,
+ Timeout,0,MaxChunkSz) of
+ {last_chunk,_ExtensionList} -> % Ignore extension
+ TrailH=read_headers_old(Info#mod.socket_type,Info#mod.socket,
+ Timeout),
+ H=Info#mod.headers,
+ OtherHeaders=H#req_headers.other++TrailH,
+ Info#mod{headers=H#req_headers{other=OtherHeaders}};
+ {Chunk,ChunkSize,_ExtensionList} -> % Ignore extension
+ Info1=Info#mod{entity_body= <<(Info#mod.entity_body)/binary,
+ Chunk/binary>>},
+ read_server_chunked_body(Info1,Timeout,MaxChunkSz-ChunkSize);
+ {error,Reason} ->
+ throw({error,Reason})
+ end.
+
+
+read_chunk(Scheme,Socket,Timeout,Int,MaxChunkSz) when MaxChunkSz>Int ->
+ case read_more_data(Scheme,Socket,1,Timeout) of
+ <<C>> when $0=<C,C=<$9 ->
+ read_chunk(Scheme,Socket,Timeout,16*Int+(C-$0),MaxChunkSz);
+ <<C>> when $a=<C,C=<$f ->
+ read_chunk(Scheme,Socket,Timeout,16*Int+10+(C-$a),MaxChunkSz);
+ <<C>> when $A=<C,C=<$F ->
+ read_chunk(Scheme,Socket,Timeout,16*Int+10+(C-$A),MaxChunkSz);
+ <<$;>> when Int>0 ->
+ ExtensionList=read_chunk_ext_name(Scheme,Socket,Timeout,[],[]),
+ read_chunk_data(Scheme,Socket,Int+1,ExtensionList,Timeout);
+ <<$;>> when Int==0 ->
+ ExtensionList=read_chunk_ext_name(Scheme,Socket,Timeout,[],[]),
+ read_data_lf(Scheme,Socket,Timeout),
+ {last_chunk,ExtensionList};
+ <<?CR>> when Int>0 ->
+ read_chunk_data(Scheme,Socket,Int+1,[],Timeout);
+ <<?CR>> when Int==0 ->
+ read_data_lf(Scheme,Socket,Timeout),
+ {last_chunk,[]};
+ <<C>> when C==$ -> % Some servers (e.g., Apache 1.3.6) throw in
+ % additional whitespace...
+ read_chunk(Scheme,Socket,Timeout,Int,MaxChunkSz);
+ _Other ->
+ {error,unexpected_chunkdata}
+ end;
+read_chunk(_Scheme,_Socket,_Timeout,_Int,_MaxChunkSz) ->
+ {error,body_too_big}.
+
+
+%%% Note:
+%%% - Got the initial ?CR already!
+%%% - Bitsyntax does not allow matching of ?CR,?LF in the end of the first read
+read_chunk_data(Scheme,Socket,Int,ExtensionList,Timeout) ->
+ case read_more_data(Scheme,Socket,Int,Timeout) of
+ <<?LF,Chunk/binary>> ->
+ case read_more_data(Scheme,Socket,2,Timeout) of
+ <<?CR,?LF>> ->
+ {Chunk,size(Chunk),ExtensionList};
+ _ ->
+ {error,bad_chunkdata}
+ end;
+ _ ->
+ {error,bad_chunkdata}
+ end.
+
+read_chunk_ext_name(Scheme,Socket,Timeout,Name,Acc) ->
+ Len=length(Name),
+ case read_more_data(Scheme,Socket,1,Timeout) of
+ $= when Len>0 ->
+ read_chunk_ext_val(Scheme,Socket,Timeout,Name,[],Acc);
+ $; when Len>0 ->
+ read_chunk_ext_name(Scheme,Socket,Timeout,[],
+ [{lists:reverse(Name),""}|Acc]);
+ ?CR when Len>0 ->
+ lists:reverse([{lists:reverse(Name,"")}|Acc]);
+ Token -> % FIXME Check that it is "token"
+ read_chunk_ext_name(Scheme,Socket,Timeout,[Token|Name],Acc);
+ _ ->
+ {error,bad_chunk_extension_name}
+ end.
+
+read_chunk_ext_val(Scheme,Socket,Timeout,Name,Val,Acc) ->
+ Len=length(Val),
+ case read_more_data(Scheme,Socket,1,Timeout) of
+ $; when Len>0 ->
+ read_chunk_ext_name(Scheme,Socket,Timeout,[],
+ [{Name,lists:reverse(Val)}|Acc]);
+ ?CR when Len>0 ->
+ lists:reverse([{Name,lists:reverse(Val)}|Acc]);
+ Token -> % FIXME Check that it is "token" or "quoted-string"
+ read_chunk_ext_val(Scheme,Socket,Timeout,Name,[Token|Val],Acc);
+ _ ->
+ {error,bad_chunk_extension_value}
+ end.
+
+read_data_lf(Scheme,Socket,Timeout) ->
+ case read_more_data(Scheme,Socket,1,Timeout) of
+ ?LF ->
+ ok;
+ _ ->
+ {error,bad_chunkdata}
+ end.
+
+%%% ----------------------------------------------------------------------------
+%%% The body was "multipart/byteranges", decode it.
+%%% Example from RFC 2616, Appendix 19.2
+%%% HTTP/1.1 206 Partial Content
+%%% Date: Wed, 15 Nov 1995 06:25:24 GMT
+%%% Last-Modified: Wed, 15 Nov 1995 04:58:08 GMT
+%%% Content-type: multipart/byteranges; boundary=THIS_STRING_SEPARATES
+%%%
+%%% --THIS_STRING_SEPARATES
+%%% Content-type: application/pdf
+%%% Content-range: bytes 500-999/8000
+%%%
+%%% ...the first range...
+%%% --THIS_STRING_SEPARATES
+%%% Content-type: application/pdf
+%%% Content-range: bytes 7000-7999/8000
+%%%
+%%% ...the second range
+%%% --THIS_STRING_SEPARATES--
+%%%
+%%% Notes:
+%%%
+%%% 1) Additional CRLFs may precede the first boundary string in the
+%%% entity.
+%%% FIXME!!
+read_client_multipartrange_body(Info,Parstr,Timeout) ->
+ Boundary=get_boundary(Parstr),
+ scan_boundary(Info,Boundary),
+ Info#response{body=read_multipart_body(Info,Boundary,Timeout)}.
+
+read_multipart_body(Info,Boundary,Timeout) ->
+ Info.
+
+% Headers=read_headers_old(Info#response.scheme,Info#response.socket,Timeout),
+% H=Info#response.headers,
+% OtherHeaders=H#res_headers.other++TrailH,
+% Info#response{headers=H#res_headers{other=OtherHeaders}}.
+
+
+scan_boundary(Info,Boundary) ->
+ Info.
+
+
+get_boundary(Parstr) ->
+ case skip_lwsp(Parstr) of
+ [] ->
+ throw({error,missing_range_boundary_parameter});
+ Val ->
+ get_boundary2(string:tokens(Val, ";"))
+ end.
+
+get_boundary2([]) ->
+ undefined;
+get_boundary2([Param|Rest]) ->
+ case string:tokens(skip_lwsp(Param), "=") of
+ ["boundary"++Attribute,Value] ->
+ Value;
+ _ ->
+ get_boundary2(Rest)
+ end.
+
+
+%% skip space & tab
+skip_lwsp([$ | Cs]) -> skip_lwsp(Cs);
+skip_lwsp([$\t | Cs]) -> skip_lwsp(Cs);
+skip_lwsp(Cs) -> Cs.
+
+%%% ----------------------------------------------------------------------------
+
+%%% Read the incoming data from the open socket.
+read_more_data(http,Socket,Len,Timeout) ->
+ case gen_tcp:recv(Socket,Len,Timeout) of
+ {ok,Val} ->
+ Val;
+ {error, timeout} ->
+ throw({error, session_local_timeout});
+ {error, Reason} when Reason==closed;Reason==enotconn ->
+ throw({error, session_remotely_closed});
+ {error, Reason} ->
+% httpd_response:send_status(Info,400,none),
+ throw({error, Reason})
+ end;
+read_more_data(https,Socket,Len,Timeout) ->
+ case ssl:recv(Socket,Len,Timeout) of
+ {ok,Val} ->
+ Val;
+ {error, etimedout} ->
+ throw({error, session_local_timeout});
+ {error, Reason} when Reason==closed;Reason==enotconn ->
+ throw({error, session_remotely_closed});
+ {error, Reason} ->
+% httpd_response:send_status(Info,400,none),
+ throw({error, Reason})
+ end.
+
+
+%% =============================================================================
+%%% Socket handling
+
+accept(http,ListenSocket, Timeout) ->
+ gen_tcp:accept(ListenSocket, Timeout);
+accept(https,ListenSocket, Timeout) ->
+ ssl:accept(ListenSocket, Timeout).
+
+
+close(http,Socket) ->
+ gen_tcp:close(Socket);
+close(https,Socket) ->
+ ssl:close(Socket).
+
+
+connect(#request{scheme=http,settings=Settings,address=Addr}) ->
+ case proxyusage(Addr,Settings) of
+ {error,Reason} ->
+ {error,Reason};
+ {Host,Port} ->
+ Opts=[binary,{active,false},{reuseaddr,true}],
+ gen_tcp:connect(Host,Port,Opts)
+ end;
+connect(#request{scheme=https,settings=Settings,address=Addr}) ->
+ case proxyusage(Addr,Settings) of
+ {error,Reason} ->
+ {error,Reason};
+ {Host,Port} ->
+ Opts=case Settings#client_settings.ssl of
+ false ->
+ [binary,{active,false}];
+ SSLSettings ->
+ [binary,{active,false}]++SSLSettings
+ end,
+ ssl:connect(Host,Port,Opts)
+ end.
+
+
+%%% Check to see if the given {Host,Port} tuple is in the NoProxyList
+%%% Returns an eventually updated {Host,Port} tuple, with the proxy address
+proxyusage(HostPort,Settings) ->
+ case Settings#client_settings.useproxy of
+ true ->
+ case noProxy(HostPort,Settings#client_settings.noproxylist) of
+ true ->
+ HostPort;
+ _ ->
+ case Settings#client_settings.proxy of
+ undefined ->
+ {error,no_proxy_defined};
+ ProxyHostPort ->
+ ProxyHostPort
+ end
+ end;
+ _ ->
+ HostPort
+ end.
+
+noProxy(_HostPort,[]) ->
+ false;
+noProxy({Host,Port},[{Host,Port}|Rest]) ->
+ true;
+noProxy(HostPort,[_|Rest]) ->
+ noProxy(HostPort,Rest).
+
+
+controlling_process(http,Socket,Pid) ->
+ gen_tcp:controlling_process(Socket,Pid);
+controlling_process(https,Socket,Pid) ->
+ ssl:controlling_process(Socket,Pid).
+
+
+deliver(SocketType, Socket, Message) ->
+ case send(SocketType, Socket, Message) of
+ {error, einval} ->
+ close(SocketType, Socket),
+ socket_closed;
+ {error, _Reason} ->
+% ?vlog("deliver(~p) failed for reason:"
+% "~n Reason: ~p",[SocketType,_Reason]),
+ close(SocketType, Socket),
+ socket_closed;
+ _Other ->
+ ok
+ end.
+
+
+recv0(http,Socket,Timeout) ->
+ gen_tcp:recv(Socket,0,Timeout);
+recv0(https,Socket,Timeout) ->
+ ssl:recv(Socket,0,Timeout).
+
+recv(http,Socket,Len,Timeout) ->
+ gen_tcp:recv(Socket,Len,Timeout);
+recv(https,Socket,Len,Timeout) ->
+ ssl:recv(Socket,Len,Timeout).
+
+
+setopts(http,Socket,Options) ->
+ inet:setopts(Socket,Options);
+setopts(https,Socket,Options) ->
+ ssl:setopts(Socket,Options).
+
+
+send(http,Socket,Message) ->
+ gen_tcp:send(Socket,Message);
+send(https,Socket,Message) ->
+ ssl:send(Socket,Message).
+
+
+%%% ============================================================================
+%%% HTTP Server only
+
+%%% Returns the Authenticating data in the HTTP request
+get_auth_data("Basic "++EncodedString) ->
+ UnCodedString=httpd_util:decode_base64(EncodedString),
+ case catch string:tokens(UnCodedString,":") of
+ [User,PassWord] ->
+ {User,PassWord};
+ {error,Error}->
+ {error,Error}
+ end;
+get_auth_data(BadCredentials) when list(BadCredentials) ->
+ {error,BadCredentials};
+get_auth_data(_) ->
+ {error,nouser}.
+
+
+create_header_list(H) ->
+ lookup(connection,H#req_headers.connection)++
+ lookup(host,H#req_headers.host)++
+ lookup(content_length,H#req_headers.content_length)++
+ lookup(transfer_encoding,H#req_headers.transfer_encoding)++
+ lookup(authorization,H#req_headers.authorization)++
+ lookup(user_agent,H#req_headers.user_agent)++
+ lookup(user_agent,H#req_headers.range)++
+ lookup(user_agent,H#req_headers.if_range)++
+ lookup(user_agent,H#req_headers.if_match)++
+ lookup(user_agent,H#req_headers.if_none_match)++
+ lookup(user_agent,H#req_headers.if_modified_since)++
+ lookup(user_agent,H#req_headers.if_unmodified_since)++
+ H#req_headers.other.
+
+lookup(_Key,undefined) ->
+ [];
+lookup(Key,Val) ->
+ [{Key,Val}].
+
+
+
+%%% ============================================================================
+%%% This code is for parsing trailer headers in chunked messages.
+%%% Will be deprecated whenever I have found an alternative working solution!
+%%% Note:
+%%% - The header names are returned slighly different from what the what
+%%% inet_drv returns
+read_headers_old(Scheme,Socket,Timeout) ->
+ read_headers_old(<<>>,Scheme,Socket,Timeout,[],[]).
+
+read_headers_old(<<>>,Scheme,Socket,Timeout,Acc,AccHdrs) ->
+ read_headers_old(read_more_data(Scheme,Socket,1,Timeout),
+ Scheme,Socket,Timeout,Acc,AccHdrs);
+read_headers_old(<<$\r>>,Scheme,Socket,Timeout,Acc,AccHdrs) ->
+ read_headers_old(<<$\r,(read_more_data(Scheme,Socket,1,Timeout))/binary>>,
+ Scheme,Socket,Timeout,Acc,AccHdrs);
+read_headers_old(<<$\r,$\n>>,Scheme,Socket,Timeout,Acc,AccHdrs) ->
+ if
+ Acc==[] -> % Done!
+ tagup_header(lists:reverse(AccHdrs));
+ true ->
+ read_headers_old(read_more_data(Scheme,Socket,1,Timeout),
+ Scheme,Socket,
+ Timeout,[],[lists:reverse(Acc)|AccHdrs])
+ end;
+read_headers_old(<<C>>,Scheme,Socket,Timeout,Acc,AccHdrs) ->
+ read_headers_old(read_more_data(Scheme,Socket,1,Timeout),
+ Scheme,Socket,Timeout,[C|Acc],AccHdrs);
+read_headers_old(Bin,_Scheme,_Socket,_Timeout,_Acc,_AccHdrs) ->
+ io:format("ERROR: Unexpected data from inet driver: ~p",[Bin]),
+ throw({error,this_is_a_bug}).
+
+
+%% Parses the header of a HTTP request and returns a key,value tuple
+%% list containing Name and Value of each header directive as of:
+%%
+%% Content-Type: multipart/mixed -> {"Content-Type", "multipart/mixed"}
+%%
+%% But in http/1.1 the field-names are case insencitive so now it must be
+%% Content-Type: multipart/mixed -> {"content-type", "multipart/mixed"}
+%% The standard furthermore says that leading and traling white space
+%% is not a part of the fieldvalue and shall therefore be removed.
+tagup_header([]) -> [];
+tagup_header([Line|Rest]) -> [tag(Line, [])|tagup_header(Rest)].
+
+tag([], Tag) ->
+ {httpd_util:to_lower(lists:reverse(Tag)), ""};
+tag([$:|Rest], Tag) ->
+ {httpd_util:to_lower(lists:reverse(Tag)), httpd_util:strip(Rest)};
+tag([Chr|Rest], Tag) ->
+ tag(Rest, [Chr|Tag]).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_handler.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_handler.erl
new file mode 100644
index 0000000000..5076a12aaa
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_handler.erl
@@ -0,0 +1,724 @@
+%% ``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 Mobile Arts AB
+%% Portions created by Mobile Arts are Copyright 2002, Mobile Arts AB
+%% All Rights Reserved.''
+%%
+%%
+
+%%% TODO:
+%%% - If an error is returned when sending a request, don't use this
+%%% session anymore.
+%%% - Closing of sessions not properly implemented for some cases
+
+%%% File : httpc_handler.erl
+%%% Author : Johan Blom <[email protected]>
+%%% Description : Handles HTTP client responses, for a single TCP session
+%%% Created : 4 Mar 2002 by Johan Blom
+
+-module(httpc_handler).
+
+-include("http.hrl").
+-include("jnets_httpd.hrl").
+
+-export([init_connection/2,http_request/2]).
+
+%%% ==========================================================================
+%%% "Main" function in the spawned process for the session.
+init_connection(Req,Session) when record(Req,request) ->
+ case catch http_lib:connect(Req) of
+ {ok,Socket} ->
+ case catch http_request(Req,Socket) of
+ ok ->
+ case Session#session.clientclose of
+ true ->
+ ok;
+ false ->
+ httpc_manager:register_socket(Req#request.address,
+ Session#session.id,
+ Socket)
+ end,
+ next_response_with_request(Req,
+ Session#session{socket=Socket});
+ {error,Reason} -> % Not possible to use new session
+ gen_server:cast(Req#request.from,
+ {Req#request.ref,Req#request.id,{error,Reason}}),
+ exit_session_ok(Req#request.address,
+ Session#session{socket=Socket})
+ end;
+ {error,Reason} -> % Not possible to set up new session
+ gen_server:cast(Req#request.from,
+ {Req#request.ref,Req#request.id,{error,Reason}}),
+ exit_session_ok2(Req#request.address,
+ Session#session.clientclose,Session#session.id)
+ end.
+
+next_response_with_request(Req,Session) ->
+ Timeout=(Req#request.settings)#client_settings.timeout,
+ case catch read(Timeout,Session#session.scheme,Session#session.socket) of
+ {Status,Headers,Body} ->
+ NewReq=handle_response({Status,Headers,Body},Timeout,Req,Session),
+ next_response_with_request(NewReq,Session);
+ {error,Reason} ->
+ gen_server:cast(Req#request.from,
+ {Req#request.ref,Req#request.id,{error,Reason}}),
+ exit_session(Req#request.address,Session,aborted_request);
+ {'EXIT',Reason} ->
+ gen_server:cast(Req#request.from,
+ {Req#request.ref,Req#request.id,{error,Reason}}),
+ exit_session(Req#request.address,Session,aborted_request)
+ end.
+
+handle_response(Response,Timeout,Req,Session) ->
+ case http_response(Response,Req,Session) of
+ ok ->
+ next_response(Timeout,Req#request.address,Session);
+ stop ->
+ exit(normal);
+ {error,Reason} ->
+ gen_server:cast(Req#request.from,
+ {Req#request.ref,Req#request.id,{error,Reason}}),
+ exit_session(Req#request.address,Session,aborted_request)
+ end.
+
+
+
+%%% Wait for the next respond until
+%%% - session is closed by the other side
+%%% => set up a new a session, if there are pending requests in the que
+%%% - "Connection:close" header is received
+%%% => close the connection (release socket) then
+%%% set up a new a session, if there are pending requests in the que
+%%%
+%%% Note:
+%%% - When invoked there are no pending responses on received requests.
+%%% - Never close the session explicitly, let it timeout instead!
+next_response(Timeout,Address,Session) ->
+ case httpc_manager:next_request(Address,Session#session.id) of
+ no_more_requests ->
+ %% There are no more pending responses, now just wait for
+ %% timeout or a new response.
+ case catch read(Timeout,
+ Session#session.scheme,Session#session.socket) of
+ {error,Reason} when Reason==session_remotely_closed;
+ Reason==session_local_timeout ->
+ exit_session_ok(Address,Session);
+ {error,Reason} ->
+ exit_session(Address,Session,aborted_request);
+ {'EXIT',Reason} ->
+ exit_session(Address,Session,aborted_request);
+ {Status2,Headers2,Body2} ->
+ case httpc_manager:next_request(Address,
+ Session#session.id) of
+ no_more_requests -> % Should not happen!
+ exit_session(Address,Session,aborted_request);
+ {error,Reason} -> % Should not happen!
+ exit_session(Address,Session,aborted_request);
+ NewReq ->
+ handle_response({Status2,Headers2,Body2},
+ Timeout,NewReq,Session)
+ end
+ end;
+ {error,Reason} -> % The connection has been closed by httpc_manager
+ exit_session(Address,Session,aborted_request);
+ NewReq ->
+ NewReq
+ end.
+
+%% ===========================================================================
+%% Internals
+
+%%% Read in and parse response data from the socket
+read(Timeout,SockType,Socket) ->
+ Info=#response{scheme=SockType,socket=Socket},
+ http_lib:setopts(SockType,Socket,[{packet, http}]),
+ Info1=read_response(SockType,Socket,Info,Timeout),
+ http_lib:setopts(SockType,Socket,[binary,{packet, raw}]),
+ case (Info1#response.headers)#res_headers.content_type of
+ "multipart/byteranges"++Param ->
+ range_response_body(Info1,Timeout,Param);
+ _ ->
+ #response{status=Status2,headers=Headers2,body=Body2}=
+ http_lib:read_client_body(Info1,Timeout),
+ {Status2,Headers2,Body2}
+ end.
+
+
+%%% From RFC 2616:
+%%% Status-Line = HTTP-Version SP Status-Code SP Reason-Phrase CRLF
+%%% HTTP-Version = "HTTP" "/" 1*DIGIT "." 1*DIGIT
+%%% Status-Code = 3DIGIT
+%%% Reason-Phrase = *<TEXT, excluding CR, LF>
+read_response(SockType,Socket,Info,Timeout) ->
+ case http_lib:recv0(SockType,Socket,Timeout) of
+ {ok,{http_response,{1,VerMin}, Status, _Phrase}} when VerMin==0;
+ VerMin==1 ->
+ Info1=Info#response{status=Status,http_version=VerMin},
+ http_lib:read_client_headers(Info1,Timeout);
+ {ok,{http_response,_Version, _Status, _Phrase}} ->
+ throw({error,bad_status_line});
+ {error, timeout} ->
+ throw({error,session_local_timeout});
+ {error, Reason} when Reason==closed;Reason==enotconn ->
+ throw({error,session_remotely_closed});
+ {error, Reason} ->
+ throw({error,Reason})
+ end.
+
+%%% From RFC 2616, Section 4.4, Page 34
+%% 4.If the message uses the media type "multipart/byteranges", and the
+%% transfer-length is not otherwise specified, then this self-
+%% delimiting media type defines the transfer-length. This media type
+%% MUST NOT be used unless the sender knows that the recipient can parse
+%% it; the presence in a request of a Range header with multiple byte-
+%% range specifiers from a 1.1 client implies that the client can parse
+%% multipart/byteranges responses.
+%%% FIXME !!
+range_response_body(Info,Timeout,Param) ->
+ Headers=Info#response.headers,
+ case {Headers#res_headers.content_length,
+ Headers#res_headers.transfer_encoding} of
+ {undefined,undefined} ->
+ #response{status=Status2,headers=Headers2,body=Body2}=
+ http_lib:read_client_multipartrange_body(Info,Param,Timeout),
+ {Status2,Headers2,Body2};
+ _ ->
+ #response{status=Status2,headers=Headers2,body=Body2}=
+ http_lib:read_client_body(Info,Timeout),
+ {Status2,Headers2,Body2}
+ end.
+
+
+%%% ----------------------------------------------------------------------------
+%%% Host: field is required when addressing multi-homed sites ...
+%%% It must not be present when the request is being made to a proxy.
+http_request(#request{method=Method,id=Id,
+ scheme=Scheme,address={Host,Port},pathquery=PathQuery,
+ headers=Headers, content={ContentType,Body},
+ settings=Settings},
+ Socket) ->
+ PostData=
+ if
+ Method==post;Method==put ->
+ case Headers#req_headers.expect of
+ "100-continue" ->
+ content_type_header(ContentType) ++
+ content_length_header(length(Body)) ++
+ "\r\n";
+ _ ->
+ content_type_header(ContentType) ++
+ content_length_header(length(Body)) ++
+ "\r\n" ++ Body
+ end;
+ true ->
+ "\r\n"
+ end,
+ Message=
+ case useProxy(Settings#client_settings.useproxy,
+ {Scheme,Host,Port,PathQuery}) of
+ false ->
+ method(Method)++" "++PathQuery++" HTTP/1.1\r\n"++
+ host_header(Host)++te_header()++
+ headers(Headers) ++ PostData;
+ AbsURI ->
+ method(Method)++" "++AbsURI++" HTTP/1.1\r\n"++
+ te_header()++
+ headers(Headers)++PostData
+ end,
+ http_lib:send(Scheme,Socket,Message).
+
+useProxy(false,_) ->
+ false;
+useProxy(true,{Scheme,Host,Port,PathQuery}) ->
+ [atom_to_list(Scheme),"://",Host,":",integer_to_list(Port),PathQuery].
+
+
+
+headers(#req_headers{expect=Expect,
+ other=Other}) ->
+ H1=case Expect of
+ undefined ->[];
+ _ -> "Expect: "++Expect++"\r\n"
+ end,
+ H1++headers_other(Other).
+
+
+headers_other([]) ->
+ [];
+headers_other([{Key,Value}|Rest]) when atom(Key) ->
+ Head = atom_to_list(Key)++": "++Value++"\r\n",
+ Head ++ headers_other(Rest);
+headers_other([{Key,Value}|Rest]) ->
+ Head = Key++": "++Value++"\r\n",
+ Head ++ headers_other(Rest).
+
+host_header(Host) ->
+ "Host: "++lists:concat([Host])++"\r\n".
+content_type_header(ContentType) ->
+ "Content-Type: " ++ ContentType ++ "\r\n".
+content_length_header(ContentLength) ->
+ "Content-Length: "++integer_to_list(ContentLength) ++ "\r\n".
+te_header() ->
+ "TE: \r\n".
+
+method(Method) ->
+ httpd_util:to_upper(atom_to_list(Method)).
+
+
+%%% ----------------------------------------------------------------------------
+http_response({Status,Headers,Body},Req,Session) ->
+ case Status of
+ 100 ->
+ status_continue(Req,Session);
+ 200 ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {Status,Headers,Body}}),
+ ServerClose=http_lib:connection_close(Headers),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ 300 -> status_multiple_choices(Headers,Body,Req,Session);
+ 301 -> status_moved_permanently(Req#request.method,
+ Headers,Body,Req,Session);
+ 302 -> status_found(Headers,Body,Req,Session);
+ 303 -> status_see_other(Headers,Body,Req,Session);
+ 304 -> status_not_modified(Headers,Body,Req,Session);
+ 305 -> status_use_proxy(Headers,Body,Req,Session);
+ %% 306 This Status code is not used in HTTP 1.1
+ 307 -> status_temporary_redirect(Headers,Body,Req,Session);
+ 503 -> status_service_unavailable({Status,Headers,Body},Req,Session);
+ Status50x when Status50x==500;Status50x==501;Status50x==502;
+ Status50x==504;Status50x==505 ->
+ status_server_error_50x({Status,Headers,Body},Req,Session);
+ _ -> % FIXME May want to take some action on other Status codes as well
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {Status,Headers,Body}}),
+ ServerClose=http_lib:connection_close(Headers),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session)
+ end.
+
+
+%%% Status code dependent functions.
+
+%%% Received a 100 Status code ("Continue")
+%%% From RFC2616
+%%% The client SHOULD continue with its request. This interim response is
+%%% used to inform the client that the initial part of the request has
+%%% been received and has not yet been rejected by the server. The client
+%%% SHOULD continue by sending the remainder of the request or, if the
+%%% request has already been completed, ignore this response. The server
+%%% MUST send a final response after the request has been completed. See
+%%% section 8.2.3 for detailed discussion of the use and handling of this
+%%% status code.
+status_continue(Req,Session) ->
+ {_,Body}=Req#request.content,
+ http_lib:send(Session#session.scheme,Session#session.socket,Body),
+ next_response_with_request(Req,Session).
+
+
+%%% Received a 300 Status code ("Multiple Choices")
+%%% The resource is located in any one of a set of locations
+%%% - If a 'Location' header is present (preserved server choice), use that
+%%% to automatically redirect to the given URL
+%%% - else if the Content-Type/Body both are non-empty let the user agent make
+%%% the choice and thus return a response with status 300
+%%% Note:
+%%% - If response to a HEAD request, the Content-Type/Body both should be empty.
+%%% - The behaviour on an empty Content-Type or Body is unspecified.
+%%% However, e.g. "Apache/1.3" servers returns both empty if the header
+%%% 'if-modified-since: Date' was sent in the request and the content is
+%%% "not modified" (instead of 304). Thus implicitly giving the cache as the
+%%% only choice.
+status_multiple_choices(Headers,Body,Req,Session)
+ when ((Req#request.settings)#client_settings.autoredirect)==true ->
+ ServerClose=http_lib:connection_close(Headers),
+ case Headers#res_headers.location of
+ undefined ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {300,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ RedirUrl ->
+ Scheme=Session#session.scheme,
+ case uri:parse(RedirUrl) of
+ {error,Reason} ->
+ {error,Reason};
+ {Scheme,Host,Port,PathQuery} -> % Automatic redirection
+ NewReq=Req#request{redircount=Req#request.redircount+1,
+ address={Host,Port},pathquery=PathQuery},
+ handle_redirect(Session#session.clientclose,ServerClose,
+ NewReq,Session)
+ end
+ end;
+status_multiple_choices(Headers,Body,Req,Session) ->
+ ServerClose=http_lib:connection_close(Headers),
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {300,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,Req,Session).
+
+
+%%% Received a 301 Status code ("Moved Permanently")
+%%% The resource has been assigned a new permanent URI
+%%% - If a 'Location' header is present, use that to automatically redirect to
+%%% the given URL if GET or HEAD request
+%%% - else return
+%%% Note:
+%%% - The Body should contain a short hypertext note with a hyperlink to the
+%%% new URI. Return this if Content-Type acceptable (some HTTP servers doesn't
+%%% deal properly with Accept headers)
+status_moved_permanently(Method,Headers,Body,Req,Session)
+ when (((Req#request.settings)#client_settings.autoredirect)==true) and
+ (Method==get) or (Method==head) ->
+ ServerClose=http_lib:connection_close(Headers),
+ case Headers#res_headers.location of
+ undefined ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {301,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ RedirUrl ->
+ Scheme=Session#session.scheme,
+ case uri:parse(RedirUrl) of
+ {error,Reason} ->
+ {error,Reason};
+ {Scheme,Host,Port,PathQuery} -> % Automatic redirection
+ NewReq=Req#request{redircount=Req#request.redircount+1,
+ address={Host,Port},pathquery=PathQuery},
+ handle_redirect(Session#session.clientclose,ServerClose,
+ NewReq,Session)
+ end
+ end;
+status_moved_permanently(_Method,Headers,Body,Req,Session) ->
+ ServerClose=http_lib:connection_close(Headers),
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {301,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,Req,Session).
+
+
+%%% Received a 302 Status code ("Found")
+%%% The requested resource resides temporarily under a different URI.
+%%% Note:
+%%% - Only cacheable if indicated by a Cache-Control or Expires header
+status_found(Headers,Body,Req,Session)
+ when ((Req#request.settings)#client_settings.autoredirect)==true ->
+ ServerClose=http_lib:connection_close(Headers),
+ case Headers#res_headers.location of
+ undefined ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {302,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ RedirUrl ->
+ Scheme=Session#session.scheme,
+ case uri:parse(RedirUrl) of
+ {error,Reason} ->
+ {error,Reason};
+ {Scheme,Host,Port,PathQuery} -> % Automatic redirection
+ NewReq=Req#request{redircount=Req#request.redircount+1,
+ address={Host,Port},pathquery=PathQuery},
+ handle_redirect(Session#session.clientclose,ServerClose,
+ NewReq,Session)
+ end
+ end;
+status_found(Headers,Body,Req,Session) ->
+ ServerClose=http_lib:connection_close(Headers),
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {302,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,Req,Session).
+
+%%% Received a 303 Status code ("See Other")
+%%% The request found under a different URI and should be retrieved using GET
+%%% Note:
+%%% - Must not be cached
+status_see_other(Headers,Body,Req,Session)
+ when ((Req#request.settings)#client_settings.autoredirect)==true ->
+ ServerClose=http_lib:connection_close(Headers),
+ case Headers#res_headers.location of
+ undefined ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {303,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ RedirUrl ->
+ Scheme=Session#session.scheme,
+ case uri:parse(RedirUrl) of
+ {error,Reason} ->
+ {error,Reason};
+ {Scheme,Host,Port,PathQuery} -> % Automatic redirection
+ NewReq=Req#request{redircount=Req#request.redircount+1,
+ method=get,
+ address={Host,Port},pathquery=PathQuery},
+ handle_redirect(Session#session.clientclose,ServerClose,
+ NewReq,Session)
+ end
+ end;
+status_see_other(Headers,Body,Req,Session) ->
+ ServerClose=http_lib:connection_close(Headers),
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {303,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,Req,Session).
+
+
+%%% Received a 304 Status code ("Not Modified")
+%%% Note:
+%%% - The response MUST NOT contain a body.
+%%% - The response MUST include the following header fields:
+%%% - Date, unless its omission is required
+%%% - ETag and/or Content-Location, if the header would have been sent
+%%% in a 200 response to the same request
+%%% - Expires, Cache-Control, and/or Vary, if the field-value might
+%%% differ from that sent in any previous response for the same
+%%% variant
+status_not_modified(Headers,Body,Req,Session)
+ when ((Req#request.settings)#client_settings.autoredirect)==true ->
+ ServerClose=http_lib:connection_close(Headers),
+ case Headers#res_headers.location of
+ undefined ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {304,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ RedirUrl ->
+ Scheme=Session#session.scheme,
+ case uri:parse(RedirUrl) of
+ {error,Reason} ->
+ {error,Reason};
+ {Scheme,Host,Port,PathQuery} -> % Automatic redirection
+ NewReq=Req#request{redircount=Req#request.redircount+1,
+ address={Host,Port},pathquery=PathQuery},
+ handle_redirect(Session#session.clientclose,ServerClose,
+ NewReq,Session)
+ end
+ end;
+status_not_modified(Headers,Body,Req,Session) ->
+ ServerClose=http_lib:connection_close(Headers),
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {304,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,Req,Session).
+
+
+
+%%% Received a 305 Status code ("Use Proxy")
+%%% The requested resource MUST be accessed through the proxy given by the
+%%% Location field
+status_use_proxy(Headers,Body,Req,Session)
+ when ((Req#request.settings)#client_settings.autoredirect)==true ->
+ ServerClose=http_lib:connection_close(Headers),
+ case Headers#res_headers.location of
+ undefined ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {305,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ RedirUrl ->
+ Scheme=Session#session.scheme,
+ case uri:parse(RedirUrl) of
+ {error,Reason} ->
+ {error,Reason};
+ {Scheme,Host,Port,PathQuery} -> % Automatic redirection
+ NewReq=Req#request{redircount=Req#request.redircount+1,
+ address={Host,Port},pathquery=PathQuery},
+ handle_redirect(Session#session.clientclose,ServerClose,
+ NewReq,Session)
+ end
+ end;
+status_use_proxy(Headers,Body,Req,Session) ->
+ ServerClose=http_lib:connection_close(Headers),
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {305,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,Req,Session).
+
+
+%%% Received a 307 Status code ("Temporary Redirect")
+status_temporary_redirect(Headers,Body,Req,Session)
+ when ((Req#request.settings)#client_settings.autoredirect)==true ->
+ ServerClose=http_lib:connection_close(Headers),
+ case Headers#res_headers.location of
+ undefined ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {307,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,
+ Req,Session);
+ RedirUrl ->
+ Scheme=Session#session.scheme,
+ case uri:parse(RedirUrl) of
+ {error,Reason} ->
+ {error,Reason};
+ {Scheme,Host,Port,PathQuery} -> % Automatic redirection
+ NewReq=Req#request{redircount=Req#request.redircount+1,
+ address={Host,Port},pathquery=PathQuery},
+ handle_redirect(Session#session.clientclose,ServerClose,
+ NewReq,Session)
+ end
+ end;
+status_temporary_redirect(Headers,Body,Req,Session) ->
+ ServerClose=http_lib:connection_close(Headers),
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {307,Headers,Body}}),
+ handle_connection(Session#session.clientclose,ServerClose,Req,Session).
+
+
+
+%%% Received a 503 Status code ("Service Unavailable")
+%%% The server is currently unable to handle the request due to a
+%%% temporary overloading or maintenance of the server. The implication
+%%% is that this is a temporary condition which will be alleviated after
+%%% some delay. If known, the length of the delay MAY be indicated in a
+%%% Retry-After header. If no Retry-After is given, the client SHOULD
+%%% handle the response as it would for a 500 response.
+%% Note:
+%% - This session is now considered busy, thus cancel any requests in the
+%% pipeline and close the session.
+%% FIXME! Implement a user option to automatically retry if the 'Retry-After'
+%% header is given.
+status_service_unavailable(Resp,Req,Session) ->
+% RetryAfter=Headers#res_headers.retry_after,
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,Resp}),
+ close_session(server_connection_close,Req,Session).
+
+
+%%% Received a 50x Status code (~ "Service Error")
+%%% Response status codes beginning with the digit "5" indicate cases in
+%%% which the server is aware that it has erred or is incapable of
+%%% performing the request.
+status_server_error_50x(Resp,Req,Session) ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,Resp}),
+ close_session(server_connection_close,Req,Session).
+
+
+%%% Handles requests for redirects
+%%% The redirected request might be:
+%%% - FIXME! on another TCP session, another scheme
+%%% - on the same TCP session, same scheme
+%%% - on another TCP session , same scheme
+%%% However, in all cases treat it as a new request, with redircount updated.
+%%%
+%%% The redirect may fail, but this not a reason to close this session.
+%%% Instead return a error for this request, and continue as ok.
+handle_redirect(ClientClose,ServerClose,Req,Session) ->
+ case httpc_manager:request(Req) of
+ {ok,_ReqId} -> % FIXME Should I perhaps reuse the Reqid?
+ handle_connection(ClientClose,ServerClose,Req,Session);
+ {error,Reason} ->
+ gen_server:cast(Req#request.from,{Req#request.ref,Req#request.id,
+ {error,Reason}}),
+ handle_connection(ClientClose,ServerClose,Req,Session)
+ end.
+
+%%% Check if the persistent connection flag is false (ie client request
+%%% non-persistive connection), or if the server requires a closed connection
+%%% (by sending a "Connection: close" header). If the connection required
+%%% non-persistent, we may close the connection immediately.
+handle_connection(ClientClose,ServerClose,Req,Session) ->
+ case {ClientClose,ServerClose} of
+ {false,false} ->
+ ok;
+ {false,true} -> % The server requests this session to be closed.
+ close_session(server_connection_close,Req,Session);
+ {true,_} -> % The client requested a non-persistent connection
+ close_session(client_connection_close,Req,Session)
+ end.
+
+
+%%% Close the session.
+%%% We now have three cases:
+%%% - Client request a non-persistent connection when initiating the request.
+%%% Session info not stored in httpc_manager
+%%% - Server requests a non-persistent connection when answering a request.
+%%% No need to resend request, but there might be a pipeline.
+%%% - Some kind of error
+%%% Close the session, we may then try resending all requests in the pipeline
+%%% including the current depending on the error.
+%%% FIXME! Should not always abort the session (see close_session in
+%%% httpc_manager for more details)
+close_session(client_connection_close,_Req,Session) ->
+ http_lib:close(Session#session.scheme,Session#session.socket),
+ stop;
+close_session(server_connection_close,Req,Session) ->
+ http_lib:close(Session#session.scheme,Session#session.socket),
+ httpc_manager:abort_session(Req#request.address,Session#session.id,
+ aborted_request),
+ stop.
+
+exit_session(Address,Session,Reason) ->
+ http_lib:close(Session#session.scheme,Session#session.socket),
+ httpc_manager:abort_session(Address,Session#session.id,Reason),
+ exit(normal).
+
+%%% This is the "normal" case to close a persistent connection. I.e., there are
+%%% no more requests waiting and the session was closed by the client, or
+%%% server because of a timeout or user request.
+exit_session_ok(Address,Session) ->
+ http_lib:close(Session#session.scheme,Session#session.socket),
+ exit_session_ok2(Address,Session#session.clientclose,Session#session.id).
+
+exit_session_ok2(Address,ClientClose,Sid) ->
+ case ClientClose of
+ false ->
+ httpc_manager:close_session(Address,Sid);
+ true ->
+ ok
+ end,
+ exit(normal).
+
+%%% ============================================================================
+%%% This is deprecated code, to be removed
+
+format_time() ->
+ {_,_,MicroSecs}=TS=now(),
+ {{Y,Mon,D},{H,M,S}}=calendar:now_to_universal_time(TS),
+ lists:flatten(io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w,~2.2.0w:~2.2.0w:~6.3.0f",
+ [Y,Mon,D,H,M,S+(MicroSecs/1000000)])).
+
+%%% Read more data from the open socket.
+%%% Two different read functions is used because for the {active, once} socket
+%%% option is (currently) not available for SSL...
+%%% FIXME
+% read_more_data(http,Socket,Timeout) ->
+% io:format("read_more_data(ip_comm) -> "
+% "~n set active = 'once' and "
+% "await a chunk data", []),
+% http_lib:setopts(Socket, [{active,once}]),
+% read_more_data_ipcomm(Socket,Timeout);
+% read_more_data(https,Socket,Timeout) ->
+% case ssl:recv(Socket,0,Timeout) of
+% {ok,MoreData} ->
+% MoreData;
+% {error,closed} ->
+% throw({error, session_remotely_closed});
+% {error,etimedout} ->
+% throw({error, session_local_timeout});
+% {error,Reason} ->
+% throw({error, Reason});
+% Other ->
+% throw({error, Other})
+% end.
+
+% %%% Send any incoming requests on the open session immediately
+% read_more_data_ipcomm(Socket,Timeout) ->
+% receive
+% {tcp,Socket,MoreData} ->
+% % ?vtrace("read_more_data(ip_comm) -> got some data:~p",
+% % [MoreData]),
+% MoreData;
+% {tcp_closed,Socket} ->
+% % ?vtrace("read_more_data(ip_comm) -> socket closed",[]),
+% throw({error,session_remotely_closed});
+% {tcp_error,Socket,Reason} ->
+% % ?vtrace("read_more_data(ip_comm) -> ~p socket error: ~p",
+% % [self(),Reason]),
+% throw({error, Reason});
+% stop ->
+% throw({error, user_req})
+% after Timeout ->
+% throw({error, session_local_timeout})
+% end.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_manager.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_manager.erl
new file mode 100644
index 0000000000..4659749270
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_manager.erl
@@ -0,0 +1,542 @@
+%% ``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 Mobile Arts AB
+%% Portions created by Mobile Arts are Copyright 2002, Mobile Arts AB
+%% All Rights Reserved.''
+%%
+%%
+%% Created : 18 Dec 2001 by Johan Blom <[email protected]>
+%%
+
+-module(httpc_manager).
+
+-behaviour(gen_server).
+
+-include("http.hrl").
+
+-define(HMACALL, ?MODULE).
+-define(HMANAME, ?MODULE).
+
+%%--------------------------------------------------------------------
+%% External exports
+-export([start_link/0,start/0,
+ request/1,cancel_request/1,
+ next_request/2,
+ register_socket/3,
+ abort_session/3,close_session/2,close_session/3
+ ]).
+
+%% Debugging only
+-export([status/0]).
+
+%% gen_server callbacks
+-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2,
+ code_change/3]).
+
+%%% address_db - ets() Contains mappings from a tuple {Host,Port} to a tuple
+%%% {LastSID,OpenSessions,ets()} where
+%%% LastSid is the last allocated session id,
+%%% OpenSessions is the number of currently open sessions and
+%%% ets() contains mappings from Session Id to #session{}.
+%%%
+%%% Note:
+%%% - Only persistent connections are stored in address_db
+%%% - When automatically redirecting, multiple requests are performed.
+-record(state,{
+ address_db, % ets()
+ reqid % int() Next Request id to use (identifies request).
+ }).
+
+%%====================================================================
+%% External functions
+%%====================================================================
+%%--------------------------------------------------------------------
+%% Function: start_link/0
+%% Description: Starts the server
+%%--------------------------------------------------------------------
+start() ->
+ ensure_started().
+
+start_link() ->
+ gen_server:start_link({local,?HMACALL}, ?HMANAME, [], []).
+
+
+%% Find available session process and store in address_db. If no
+%% available, start new handler process.
+request(Req) ->
+ ensure_started(),
+ ClientClose=http_lib:connection_close(Req#request.headers),
+ gen_server:call(?HMACALL,{request,ClientClose,Req},infinity).
+
+cancel_request(ReqId) ->
+ gen_server:call(?HMACALL,{cancel_request,ReqId},infinity).
+
+
+%%% Close Session
+close_session(Addr,Sid) ->
+ gen_server:call(?HMACALL,{close_session,Addr,Sid},infinity).
+close_session(Req,Addr,Sid) ->
+ gen_server:call(?HMACALL,{close_session,Req,Addr,Sid},infinity).
+
+abort_session(Addr,Sid,Msg) ->
+ gen_server:call(?HMACALL,{abort_session,Addr,Sid,Msg},infinity).
+
+
+%%% Pick next in request que
+next_request(Addr,Sid) ->
+ gen_server:call(?HMACALL,{next_request,Addr,Sid},infinity).
+
+%%% Session handler has succeded to set up a new session, now register
+%%% the socket
+register_socket(Addr,Sid,Socket) ->
+ gen_server:cast(?HMACALL,{register_socket,Addr,Sid,Socket}).
+
+
+%%% Debugging
+status() ->
+ gen_server:cast(?HMACALL,status).
+
+
+%%--------------------------------------------------------------------
+%% Function: init/1
+%% Description: Initiates the server
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%%--------------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok,#state{address_db=ets:new(address_db,[private]),
+ reqid=0}}.
+
+
+%%--------------------------------------------------------------------
+%% Function: handle_call/3
+%% Description: Handling call messages
+%% Returns: {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} | (terminate/2 is called)
+%% {stop, Reason, State} (terminate/2 is called)
+%%--------------------------------------------------------------------
+%%% Note:
+%%% - We may have multiple non-persistent connections, each will be handled in
+%%% separate processes, thus don't add such connections to address_db
+handle_call({request,false,Req},_From,State) ->
+ case ets:lookup(State#state.address_db,Req#request.address) of
+ [] ->
+ STab=ets:new(session_db,[private,{keypos,2},set]),
+ case persistent_new_session_request(0,Req,STab,State) of
+ {Reply,LastSid,State2} ->
+ ets:insert(State2#state.address_db,
+ {Req#request.address,{LastSid,1,STab}}),
+ {reply,Reply,State2};
+ {ErrorReply,State2} ->
+ {reply,ErrorReply,State2}
+ end;
+ [{_,{LastSid,OpenS,STab}}] ->
+ case lookup_session_entry(STab) of
+ {ok,Session} ->
+ old_session_request(Session,Req,STab,State);
+ need_new_session when OpenS<(Req#request.settings)#client_settings.max_sessions ->
+ case persistent_new_session_request(LastSid,Req,
+ STab,State) of
+ {Reply,LastSid2,State2} ->
+ ets:insert(State2#state.address_db,
+ {Req#request.address,
+ {LastSid2,OpenS+1,STab}}),
+ {reply,Reply,State2};
+ {ErrorReply,State2} ->
+ {reply,ErrorReply,State2}
+ end;
+ need_new_session ->
+ {reply,{error,too_many_sessions},State}
+ end
+ end;
+handle_call({request,true,Req},_From,State) ->
+ {Reply,State2}=not_persistent_new_session_request(Req,State),
+ {reply,Reply,State2};
+handle_call({cancel_request,true,_ReqId},_From,State) ->
+%% FIXME Should be possible to scan through all requests made, but perhaps
+%% better to give some more hints (such as Addr etc)
+ Reply=ok,
+ {reply,Reply,State};
+handle_call({next_request,Addr,Sid},_From,State) ->
+ case ets:lookup(State#state.address_db,Addr) of
+ [] ->
+ {reply,{error,no_connection},State};
+ [{_,{_,_,STab}}] ->
+ case ets:lookup(STab,Sid) of
+ [] ->
+ {reply,{error,session_not_registered},State};
+ [S=#session{pipeline=[],quelength=QueLen}] ->
+ if
+ QueLen==1 ->
+ ets:insert(STab,S#session{quelength=0});
+ true ->
+ ok
+ end,
+ {reply,no_more_requests,State};
+ [S=#session{pipeline=Que}] ->
+ [Req|RevQue]=lists:reverse(Que),
+ ets:insert(STab,S#session{pipeline=lists:reverse(RevQue),
+ quelength=S#session.quelength-1}),
+ {reply,Req,State}
+ end
+ end;
+handle_call({close_session,Addr,Sid},_From,State) ->
+ case ets:lookup(State#state.address_db,Addr) of
+ [] ->
+ {reply,{error,no_connection},State};
+ [{_,{LastSid,OpenS,STab}}] ->
+ case ets:lookup(STab,Sid) of
+ [#session{pipeline=Que}] ->
+ R=handle_close_session(lists:reverse(Que),STab,Sid,State),
+ ets:insert(State#state.address_db,
+ {Addr,{LastSid,OpenS-1,STab}}),
+ {reply,R,State};
+ [] ->
+ {reply,{error,session_not_registered},State}
+ end
+ end;
+handle_call({close_session,Req,Addr,Sid},_From,State) ->
+ case ets:lookup(State#state.address_db,Addr) of
+ [] ->
+ {reply,{error,no_connection},State};
+ [{_,{LastSid,OpenS,STab}}] ->
+ case ets:lookup(STab,Sid) of
+ [#session{pipeline=Que}] ->
+ R=handle_close_session([Req|lists:reverse(Que)],
+ STab,Sid,State),
+ ets:insert(State#state.address_db,
+ {Addr,{LastSid,OpenS-1,STab}}),
+ {reply,R,State};
+ [] ->
+ {reply,{error,session_not_registered},State}
+ end
+ end;
+handle_call({abort_session,Addr,Sid,Msg},_From,State) ->
+ case ets:lookup(State#state.address_db,Addr) of
+ [] ->
+ {reply,{error,no_connection},State};
+ [{_,{LastSid,OpenS,STab}}] ->
+ case ets:lookup(STab,Sid) of
+ [#session{pipeline=Que}] ->
+ R=abort_request_que(Que,{error,Msg}),
+ ets:delete(STab,Sid),
+ ets:insert(State#state.address_db,
+ {Addr,{LastSid,OpenS-1,STab}}),
+ {reply,R,State};
+ [] ->
+ {reply,{error,session_not_registered},State}
+ end
+ end.
+
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast/2
+%% Description: Handling cast messages
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%--------------------------------------------------------------------
+handle_cast(status, State) ->
+ io:format("Status:~n"),
+ print_all(lists:sort(ets:tab2list(State#state.address_db))),
+ {noreply, State};
+handle_cast({register_socket,Addr,Sid,Socket},State) ->
+ case ets:lookup(State#state.address_db,Addr) of
+ [] ->
+ {noreply,State};
+ [{_,{_,_,STab}}] ->
+ case ets:lookup(STab,Sid) of
+ [Session] ->
+ ets:insert(STab,Session#session{socket=Socket}),
+ {noreply,State};
+ [] ->
+ {noreply,State}
+ end
+ end.
+
+print_all([]) ->
+ ok;
+print_all([{Addr,{LastSid,OpenSessions,STab}}|Rest]) ->
+ io:format(" Address:~p LastSid=~p OpenSessions=~p~n",[Addr,LastSid,OpenSessions]),
+ SortedList=lists:sort(fun(A,B) ->
+ if
+ A#session.id<B#session.id ->
+ true;
+ true ->
+ false
+ end
+ end,ets:tab2list(STab)),
+ print_all2(SortedList),
+ print_all(Rest).
+
+print_all2([]) ->
+ ok;
+print_all2([Session|Rest]) ->
+ io:format(" Session:~p~n",[Session#session.id]),
+ io:format(" Client close:~p~n",[Session#session.clientclose]),
+ io:format(" Socket:~p~n",[Session#session.socket]),
+ io:format(" Pipe: length=~p Que=~p~n",[Session#session.quelength,Session#session.pipeline]),
+ print_all2(Rest).
+
+%%--------------------------------------------------------------------
+%% Function: handle_info/2
+%% Description: Handling all non call/cast messages
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%--------------------------------------------------------------------
+handle_info({'EXIT',_Pid,normal}, State) ->
+ {noreply, State};
+handle_info(Info, State) ->
+ io:format("ERROR httpc_manager:handle_info ~p~n",[Info]),
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: terminate/2
+%% Description: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%--------------------------------------------------------------------
+terminate(_Reason, State) ->
+ ets:delete(State#state.address_db).
+
+%%--------------------------------------------------------------------
+%% Func: code_change/3
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState}
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+%%% From RFC 2616, Section 8.1.4
+%%% A client, server, or proxy MAY close the transport connection at any
+%%% time. For example, a client might have started to send a new request
+%%% at the same time that the server has decided to close the "idle"
+%%% connection. From the server's point of view, the connection is being
+%%% closed while it was idle, but from the client's point of view, a
+%%% request is in progress.
+%%%
+%%% This means that clients, servers, and proxies MUST be able to recover
+%%% from asynchronous close events. Client software SHOULD reopen the
+%%% transport connection and retransmit the aborted sequence of requests
+%%% without user interaction so long as the request sequence is
+%%% idempotent (see section 9.1.2). Non-idempotent methods or sequences
+%%%
+%%% FIXME
+%%% Note:
+%%% - If this happen (server close because of idle) there can't be any requests
+%%% in the que.
+%%% - This is the main function for closing of sessions
+handle_close_session([],STab,Sid,_State) ->
+ ets:delete(STab,Sid);
+handle_close_session(Que,STab,Sid,_State) ->
+ ets:delete(STab,Sid),
+ abort_request_que(Que,{error,aborted_request}).
+
+
+%%% From RFC 2616, Section 8.1.2.2
+%%% Clients which assume persistent connections and pipeline immediately
+%%% after connection establishment SHOULD be prepared to retry their
+%%% connection if the first pipelined attempt fails. If a client does
+%%% such a retry, it MUST NOT pipeline before it knows the connection is
+%%% persistent. Clients MUST also be prepared to resend their requests if
+%%% the server closes the connection before sending all of the
+%%% corresponding responses.
+%%% FIXME! I'm currently not checking if tis is the first attempt on the session
+%%% FIXME! Pipeline size must be dynamically variable (e.g. 0 if resend, 2 else)
+%%% The que contains requests that have been sent ok previously, but the session
+%%% was closed prematurely when reading the response.
+%%% Try setup a new session and resend these requests.
+%%% Note:
+%%% - This MUST be a persistent session
+% handle_closed_pipelined_session_que([],_State) ->
+% ok;
+% handle_closed_pipelined_session_que(_Que,_State) ->
+% ok.
+
+
+%%% From RFC 2616, Section 8.2.4
+%%% If an HTTP/1.1 client sends a request which includes a request body,
+%%% but which does not include an Expect request-header field with the
+%%% "100-continue" expectation, and if the client is not directly
+%%% connected to an HTTP/1.1 origin server, and if the client sees the
+%%% connection close before receiving any status from the server, the
+%%% client SHOULD retry the request. If the client does retry this
+%%% request, it MAY use the following "binary exponential backoff"
+%%% algorithm to be assured of obtaining a reliable response:
+%%% ...
+%%% FIXME! I'm currently not checking if a "Expect: 100-continue" has been sent.
+% handle_remotely_closed_session_que([],_State) ->
+% ok;
+% handle_remotely_closed_session_que(_Que,_State) ->
+% % resend_que(Que,Socket),
+% ok.
+
+%%% Resend all requests in the request que
+% resend_que([],_) ->
+% ok;
+% resend_que([Req|Que],Socket) ->
+% case catch httpc_handler:http_request(Req,Socket) of
+% ok ->
+% resend_que(Que,Socket);
+% {error,Reason} ->
+% {error,Reason}
+% end.
+
+
+%%% From RFC 2616,
+%%% Section 8.1.2.2:
+%%% Clients SHOULD NOT pipeline requests using non-idempotent methods or
+%%% non-idempotent sequences of methods (see section 9.1.2). Otherwise, a
+%%% premature termination of the transport connection could lead to
+%%% indeterminate results. A client wishing to send a non-idempotent
+%%% request SHOULD wait to send that request until it has received the
+%%% response status for the previous request.
+%%% Section 9.1.2:
+%%% Methods can also have the property of "idempotence" in that (aside
+%%% from error or expiration issues) the side-effects of N > 0 identical
+%%% requests is the same as for a single request. The methods GET, HEAD,
+%%% PUT and DELETE share this property. Also, the methods OPTIONS and
+%%% TRACE SHOULD NOT have side effects, and so are inherently idempotent.
+%%%
+%%% Note that POST and CONNECT are idempotent methods.
+%%%
+%%% Tries to find an open, free session i STab. Such a session has quelength
+%%% less than ?MAX_PIPELINE_LENGTH
+%%% Don't care about non-standard, user defined methods.
+%%%
+%%% Returns {ok,Session} or need_new_session where
+%%% Session is the session that may be used
+lookup_session_entry(STab) ->
+ MS=[{#session{quelength='$1',max_quelength='$2',
+ id='_',clientclose='_',socket='$3',scheme='_',pipeline='_'},
+ [{'<','$1','$2'},{is_port,'$3'}],
+ ['$_']}],
+ case ets:select(STab,MS) of
+ [] ->
+ need_new_session;
+ SessionList -> % Now check if any of these has an empty pipeline.
+ case lists:keysearch(0,2,SessionList) of
+ {value,Session} ->
+ {ok,Session};
+ false ->
+ {ok,hd(SessionList)}
+ end
+ end.
+
+
+%%% Returns a tuple {Reply,State} where
+%%% Reply is the response sent back to the application
+%%%
+%%% Note:
+%%% - An {error,einval} from a send should sometimes rather be {error,closed}
+%%% - Don't close the session from here, let httpc_handler take care of that.
+%old_session_request(Session,Req,STab,State)
+% when (Req#request.settings)#client_settings.max_quelength==0 ->
+% Session1=Session#session{pipeline=[Req]},
+% ets:insert(STab,Session1),
+% {reply,{ok,ReqId},State#state{reqid=ReqId+1}};
+old_session_request(Session,Req,STab,State) ->
+ ReqId=State#state.reqid,
+ Req1=Req#request{id=ReqId},
+ case catch httpc_handler:http_request(Req1,Session#session.socket) of
+ ok ->
+ Session1=Session#session{pipeline=[Req1|Session#session.pipeline],
+ quelength=Session#session.quelength+1},
+ ets:insert(STab,Session1),
+ {reply,{ok,ReqId},State#state{reqid=ReqId+1}};
+ {error,Reason} ->
+ ets:insert(STab,Session#session{socket=undefined}),
+% http_lib:close(Session#session.sockettype,Session#session.socket),
+ {reply,{error,Reason},State#state{reqid=ReqId+1}}
+ end.
+
+%%% Returns atuple {Reply,Sid,State} where
+%%% Reply is the response sent back to the application, and
+%%% Sid is the last used Session Id
+persistent_new_session_request(Sid,Req,STab,State) ->
+ ReqId=State#state.reqid,
+ case setup_new_session(Req#request{id=ReqId},false,Sid) of
+ {error,Reason} ->
+ {{error,Reason},State#state{reqid=ReqId+1}};
+ {NewSid,Session} ->
+ ets:insert(STab,Session),
+ {{ok,ReqId},NewSid,State#state{reqid=ReqId+1}}
+ end.
+
+%%% Returns a tuple {Reply,State} where
+%%% Reply is the response sent back to the application
+not_persistent_new_session_request(Req,State) ->
+ ReqId=State#state.reqid,
+ case setup_new_session(Req#request{id=ReqId},true,undefined) of
+ {error,Reason} ->
+ {{error,Reason},State#state{reqid=ReqId+1}};
+ ok ->
+ {{ok,ReqId},State#state{reqid=ReqId+1}}
+ end.
+
+%%% As there are no sessions available, setup a new session and send the request
+%%% on it.
+setup_new_session(Req,ClientClose,Sid) ->
+ S=#session{id=Sid,clientclose=ClientClose,
+ scheme=Req#request.scheme,
+ max_quelength=(Req#request.settings)#client_settings.max_quelength},
+ spawn_link(httpc_handler,init_connection,[Req,S]),
+ case ClientClose of
+ false ->
+ {Sid+1,S};
+ true ->
+ ok
+ end.
+
+
+%%% ----------------------------------------------------------------------------
+%%% Abort all requests in the request que.
+abort_request_que([],_Msg) ->
+ ok;
+abort_request_que([#request{from=From,ref=Ref,id=Id}|Que],Msg) ->
+ gen_server:cast(From,{Ref,Id,Msg}),
+ abort_request_que(Que,Msg);
+abort_request_que(#request{from=From,ref=Ref,id=Id},Msg) ->
+ gen_server:cast(From,{Ref,Id,Msg}).
+
+
+%%% --------------------------------
+% C={httpc_manager,{?MODULE,start_link,[]},permanent,1000,
+% worker,[?MODULE]},
+% supervisor:start_child(inets_sup, C),
+ensure_started() ->
+ case whereis(?HMANAME) of
+ undefined ->
+ start_link();
+ _ ->
+ ok
+ end.
+
+
+%%% ============================================================================
+%%% This is deprecated code, to be removed
+
+% format_time() ->
+% {_,_,MicroSecs}=TS=now(),
+% {{Y,Mon,D},{H,M,S}}=calendar:now_to_universal_time(TS),
+% lists:flatten(io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w,~2.2.0w:~2.2.0w:~6.3.0f",
+% [Y,Mon,D,H,M,S+(MicroSecs/1000000)])).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.erl
new file mode 100644
index 0000000000..8cc1c133e9
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.erl
@@ -0,0 +1,596 @@
+%% ``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: httpd.erl,v 1.1 2008/12/17 09:53:33 mikpe Exp $
+%%
+-module(httpd).
+-export([multi_start/1, multi_start_link/1,
+ start/0, start/1, start/2,
+ start_link/0, start_link/1, start_link/2,
+ start_child/0,start_child/1,
+ multi_stop/1,
+ stop/0,stop/1,stop/2,
+ stop_child/0,stop_child/1,stop_child/2,
+ multi_restart/1,
+ restart/0,restart/1,restart/2,
+ parse_query/1]).
+
+%% Optional start related stuff...
+-export([load/1, load_mime_types/1,
+ start2/1, start2/2,
+ start_link2/1, start_link2/2,
+ stop2/1]).
+
+%% Management stuff
+-export([block/0,block/1,block/2,block/3,block/4,
+ unblock/0,unblock/1,unblock/2]).
+
+%% Debugging and status info stuff...
+-export([verbosity/3,verbosity/4]).
+-export([get_status/1,get_status/2,get_status/3,
+ get_admin_state/0,get_admin_state/1,get_admin_state/2,
+ get_usage_state/0,get_usage_state/1,get_usage_state/2]).
+
+-include("httpd.hrl").
+
+-define(D(F, A), io:format("~p:" ++ F ++ "~n", [?MODULE|A])).
+
+
+%% start
+
+start() ->
+ start("/var/tmp/server_root/conf/8888.conf").
+
+start(ConfigFile) ->
+ %% ?D("start(~s) -> entry", [ConfigFile]),
+ start(ConfigFile, []).
+
+start(ConfigFile, Verbosity) when list(ConfigFile), list(Verbosity) ->
+ httpd_sup:start(ConfigFile, Verbosity).
+
+
+%% start_link
+
+start_link() ->
+ start("/var/tmp/server_root/conf/8888.conf").
+
+start_link(ConfigFile) ->
+ start_link(ConfigFile, []).
+
+start_link(ConfigFile, Verbosity) when list(ConfigFile), list(Verbosity) ->
+ httpd_sup:start_link(ConfigFile, Verbosity).
+
+
+%% start2 & start_link2
+
+start2(Config) ->
+ start2(Config, []).
+
+start2(Config, Verbosity) when list(Config), list(Verbosity) ->
+ httpd_sup:start2(Config, Verbosity).
+
+start_link2(Config) ->
+ start_link2(Config, []).
+
+start_link2(Config, Verbosity) when list(Config), list(Verbosity) ->
+ httpd_sup:start_link2(Config, Verbosity).
+
+
+%% stop
+
+stop() ->
+ stop(8888).
+
+stop(Port) when integer(Port) ->
+ stop(undefined, Port);
+stop(Pid) when pid(Pid) ->
+ httpd_sup:stop(Pid);
+stop(ConfigFile) when list(ConfigFile) ->
+ %% ?D("stop(~s) -> entry", [ConfigFile]),
+ httpd_sup:stop(ConfigFile).
+
+stop(Addr, Port) when integer(Port) ->
+ httpd_sup:stop(Addr, Port).
+
+stop2(Config) when list(Config) ->
+ httpd_sup:stop2(Config).
+
+%% start_child
+
+start_child() ->
+ start_child("/var/tmp/server_root/conf/8888.conf").
+
+start_child(ConfigFile) ->
+ start_child(ConfigFile, []).
+
+start_child(ConfigFile, Verbosity) ->
+ inets_sup:start_child(ConfigFile, Verbosity).
+
+
+%% stop_child
+
+stop_child() ->
+ stop_child(8888).
+
+stop_child(Port) ->
+ stop_child(undefined,Port).
+
+stop_child(Addr, Port) when integer(Port) ->
+ inets_sup:stop_child(Addr, Port).
+
+
+%% multi_start
+
+multi_start(MultiConfigFile) ->
+ case read_multi_file(MultiConfigFile) of
+ {ok,ConfigFiles} ->
+ mstart(ConfigFiles);
+ Error ->
+ Error
+ end.
+
+mstart(ConfigFiles) ->
+ mstart(ConfigFiles,[]).
+mstart([],Results) ->
+ {ok,lists:reverse(Results)};
+mstart([H|T],Results) ->
+ Res = start(H),
+ mstart(T,[Res|Results]).
+
+
+%% multi_start_link
+
+multi_start_link(MultiConfigFile) ->
+ case read_multi_file(MultiConfigFile) of
+ {ok,ConfigFiles} ->
+ mstart_link(ConfigFiles);
+ Error ->
+ Error
+ end.
+
+mstart_link(ConfigFiles) ->
+ mstart_link(ConfigFiles,[]).
+mstart_link([],Results) ->
+ {ok,lists:reverse(Results)};
+mstart_link([H|T],Results) ->
+ Res = start_link(H),
+ mstart_link(T,[Res|Results]).
+
+
+%% multi_stop
+
+multi_stop(MultiConfigFile) ->
+ case read_multi_file(MultiConfigFile) of
+ {ok,ConfigFiles} ->
+ mstop(ConfigFiles);
+ Error ->
+ Error
+ end.
+
+mstop(ConfigFiles) ->
+ mstop(ConfigFiles,[]).
+mstop([],Results) ->
+ {ok,lists:reverse(Results)};
+mstop([H|T],Results) ->
+ Res = stop(H),
+ mstop(T,[Res|Results]).
+
+
+%% multi_restart
+
+multi_restart(MultiConfigFile) ->
+ case read_multi_file(MultiConfigFile) of
+ {ok,ConfigFiles} ->
+ mrestart(ConfigFiles);
+ Error ->
+ Error
+ end.
+
+mrestart(ConfigFiles) ->
+ mrestart(ConfigFiles,[]).
+mrestart([],Results) ->
+ {ok,lists:reverse(Results)};
+mrestart([H|T],Results) ->
+ Res = restart(H),
+ mrestart(T,[Res|Results]).
+
+
+%% restart
+
+restart() -> restart(undefined,8888).
+
+restart(Port) when integer(Port) ->
+ restart(undefined,Port);
+restart(ConfigFile) when list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ restart(Addr,Port);
+ Error ->
+ Error
+ end.
+
+
+restart(Addr,Port) when integer(Port) ->
+ do_restart(Addr,Port).
+
+do_restart(Addr,Port) when integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:restart(Pid);
+ _ ->
+ {error,not_started}
+ end.
+
+
+%%% =========================================================
+%%% Function: block/0, block/1, block/2, block/3, block/4
+%%% block()
+%%% block(Port)
+%%% block(ConfigFile)
+%%% block(Addr,Port)
+%%% block(Port,Mode)
+%%% block(ConfigFile,Mode)
+%%% block(Addr,Port,Mode)
+%%% block(ConfigFile,Mode,Timeout)
+%%% block(Addr,Port,Mode,Timeout)
+%%%
+%%% Returns: ok | {error,Reason}
+%%%
+%%% Description: This function is used to block an HTTP server.
+%%% The blocking can be done in two ways,
+%%% disturbing or non-disturbing. Default is disturbing.
+%%% When a HTTP server is blocked, all requests are rejected
+%%% (status code 503).
+%%%
+%%% disturbing:
+%%% By performing a disturbing block, the server
+%%% is blocked forcefully and all ongoing requests
+%%% are terminated. No new connections are accepted.
+%%% If a timeout time is given then, on-going requests
+%%% are given this much time to complete before the
+%%% server is forcefully blocked. In this case no new
+%%% connections is accepted.
+%%%
+%%% non-disturbing:
+%%% A non-disturbing block is more gracefull. No
+%%% new connections are accepted, but the ongoing
+%%% requests are allowed to complete.
+%%% If a timeout time is given, it waits this long before
+%%% giving up (the block operation is aborted and the
+%%% server state is once more not-blocked).
+%%%
+%%% Types: Port -> integer()
+%%% Addr -> {A,B,C,D} | string() | undefined
+%%% ConfigFile -> string()
+%%% Mode -> disturbing | non_disturbing
+%%% Timeout -> integer()
+%%%
+block() -> block(undefined,8888,disturbing).
+
+block(Port) when integer(Port) ->
+ block(undefined,Port,disturbing);
+
+block(ConfigFile) when list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ block(Addr,Port,disturbing);
+ Error ->
+ Error
+ end.
+
+block(Addr,Port) when integer(Port) ->
+ block(Addr,Port,disturbing);
+
+block(Port,Mode) when integer(Port), atom(Mode) ->
+ block(undefined,Port,Mode);
+
+block(ConfigFile,Mode) when list(ConfigFile), atom(Mode) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ block(Addr,Port,Mode);
+ Error ->
+ Error
+ end.
+
+
+block(Addr,Port,disturbing) when integer(Port) ->
+ do_block(Addr,Port,disturbing);
+block(Addr,Port,non_disturbing) when integer(Port) ->
+ do_block(Addr,Port,non_disturbing);
+
+block(ConfigFile,Mode,Timeout) when list(ConfigFile), atom(Mode), integer(Timeout) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ block(Addr,Port,Mode,Timeout);
+ Error ->
+ Error
+ end.
+
+
+block(Addr,Port,non_disturbing,Timeout) when integer(Port), integer(Timeout) ->
+ do_block(Addr,Port,non_disturbing,Timeout);
+block(Addr,Port,disturbing,Timeout) when integer(Port), integer(Timeout) ->
+ do_block(Addr,Port,disturbing,Timeout).
+
+do_block(Addr,Port,Mode) when integer(Port), atom(Mode) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:block(Pid,Mode);
+ _ ->
+ {error,not_started}
+ end.
+
+
+do_block(Addr,Port,Mode,Timeout) when integer(Port), atom(Mode) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:block(Pid,Mode,Timeout);
+ _ ->
+ {error,not_started}
+ end.
+
+
+%%% =========================================================
+%%% Function: unblock/0, unblock/1, unblock/2
+%%% unblock()
+%%% unblock(Port)
+%%% unblock(ConfigFile)
+%%% unblock(Addr,Port)
+%%%
+%%% Description: This function is used to reverse a previous block
+%%% operation on the HTTP server.
+%%%
+%%% Types: Port -> integer()
+%%% Addr -> {A,B,C,D} | string() | undefined
+%%% ConfigFile -> string()
+%%%
+unblock() -> unblock(undefined,8888).
+unblock(Port) when integer(Port) -> unblock(undefined,Port);
+
+unblock(ConfigFile) when list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ unblock(Addr,Port);
+ Error ->
+ Error
+ end.
+
+unblock(Addr,Port) when integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:unblock(Pid);
+ _ ->
+ {error,not_started}
+ end.
+
+
+verbosity(Port,Who,Verbosity) ->
+ verbosity(undefined,Port,Who,Verbosity).
+
+verbosity(Addr,Port,Who,Verbosity) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:verbosity(Pid,Who,Verbosity);
+ _ ->
+ not_started
+ end.
+
+
+%%% =========================================================
+%%% Function: get_admin_state/0, get_admin_state/1, get_admin_state/2
+%%% get_admin_state()
+%%% get_admin_state(Port)
+%%% get_admin_state(Addr,Port)
+%%%
+%%% Returns: {ok,State} | {error,Reason}
+%%%
+%%% Description: This function is used to retrieve the administrative
+%%% state of the HTTP server.
+%%%
+%%% Types: Port -> integer()
+%%% Addr -> {A,B,C,D} | string() | undefined
+%%% State -> unblocked | shutting_down | blocked
+%%% Reason -> term()
+%%%
+get_admin_state() -> get_admin_state(undefined,8888).
+get_admin_state(Port) when integer(Port) -> get_admin_state(undefined,Port);
+
+get_admin_state(ConfigFile) when list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ unblock(Addr,Port);
+ Error ->
+ Error
+ end.
+
+get_admin_state(Addr,Port) when integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:get_admin_state(Pid);
+ _ ->
+ {error,not_started}
+ end.
+
+
+
+%%% =========================================================
+%%% Function: get_usage_state/0, get_usage_state/1, get_usage_state/2
+%%% get_usage_state()
+%%% get_usage_state(Port)
+%%% get_usage_state(Addr,Port)
+%%%
+%%% Returns: {ok,State} | {error,Reason}
+%%%
+%%% Description: This function is used to retrieve the usage
+%%% state of the HTTP server.
+%%%
+%%% Types: Port -> integer()
+%%% Addr -> {A,B,C,D} | string() | undefined
+%%% State -> idle | active | busy
+%%% Reason -> term()
+%%%
+get_usage_state() -> get_usage_state(undefined,8888).
+get_usage_state(Port) when integer(Port) -> get_usage_state(undefined,Port);
+
+get_usage_state(ConfigFile) when list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ unblock(Addr,Port);
+ Error ->
+ Error
+ end.
+
+get_usage_state(Addr,Port) when integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:get_usage_state(Pid);
+ _ ->
+ {error,not_started}
+ end.
+
+
+
+%%% =========================================================
+%% Function: get_status(ConfigFile) -> Status
+%% get_status(Port) -> Status
+%% get_status(Addr,Port) -> Status
+%% get_status(Port,Timeout) -> Status
+%% get_status(Addr,Port,Timeout) -> Status
+%%
+%% Arguments: ConfigFile -> string()
+%% Configuration file from which Port and
+%% BindAddress will be extracted.
+%% Addr -> {A,B,C,D} | string()
+%% Bind Address of the http server
+%% Port -> integer()
+%% Port number of the http server
+%% Timeout -> integer()
+%% Timeout time for the call
+%%
+%% Returns: Status -> list()
+%%
+%% Description: This function is used when the caller runs in the
+%% same node as the http server or if calling with a
+%% program such as erl_call (see erl_interface).
+%%
+
+get_status(ConfigFile) when list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ get_status(Addr,Port);
+ Error ->
+ Error
+ end;
+
+get_status(Port) when integer(Port) ->
+ get_status(undefined,Port,5000).
+
+get_status(Port,Timeout) when integer(Port), integer(Timeout) ->
+ get_status(undefined,Port,Timeout);
+
+get_status(Addr,Port) when list(Addr), integer(Port) ->
+ get_status(Addr,Port,5000).
+
+get_status(Addr,Port,Timeout) when integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ httpd_manager:get_status(Pid,Timeout);
+ _ ->
+ not_started
+ end.
+
+
+%% load config
+
+load(ConfigFile) ->
+ httpd_conf:load(ConfigFile).
+
+load_mime_types(MimeTypesFile) ->
+ httpd_conf:load_mime_types(MimeTypesFile).
+
+
+%% parse_query
+
+parse_query(String) ->
+ {ok, SplitString} = regexp:split(String,"[&;]"),
+ foreach(SplitString).
+
+foreach([]) ->
+ [];
+foreach([KeyValue|Rest]) ->
+ {ok, Plus2Space, _} = regexp:gsub(KeyValue,"[\+]"," "),
+ case regexp:split(Plus2Space,"=") of
+ {ok,[Key|Value]} ->
+ [{httpd_util:decode_hex(Key),
+ httpd_util:decode_hex(lists:flatten(Value))}|foreach(Rest)];
+ {ok,_} ->
+ foreach(Rest)
+ end.
+
+
+%% get_addr_and_port
+
+get_addr_and_port(ConfigFile) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok,ConfigList} ->
+ Port = httpd_util:key1search(ConfigList,port,80),
+ Addr = httpd_util:key1search(ConfigList,bind_address),
+ {ok,Addr,Port};
+ Error ->
+ Error
+ end.
+
+
+%% make_name
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd",Addr,Port).
+
+
+%% Multi stuff
+%%
+
+read_multi_file(File) ->
+ read_mfile(file:open(File,[read])).
+
+read_mfile({ok,Fd}) ->
+ read_mfile(read_line(Fd),Fd,[]);
+read_mfile(Error) ->
+ Error.
+
+read_mfile(eof,_Fd,SoFar) ->
+ {ok,lists:reverse(SoFar)};
+read_mfile({error,Reason},_Fd,SoFar) ->
+ {error,Reason};
+read_mfile([$#|Comment],Fd,SoFar) ->
+ read_mfile(read_line(Fd),Fd,SoFar);
+read_mfile([],Fd,SoFar) ->
+ read_mfile(read_line(Fd),Fd,SoFar);
+read_mfile(Line,Fd,SoFar) ->
+ read_mfile(read_line(Fd),Fd,[Line|SoFar]).
+
+read_line(Fd) -> read_line1(io:get_line(Fd,[])).
+read_line1(eof) -> eof;
+read_line1(String) -> httpd_conf:clean(String).
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.hrl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.hrl
new file mode 100644
index 0000000000..ba21bdf638
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.hrl
@@ -0,0 +1,77 @@
+%% ``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: httpd.hrl,v 1.1 2008/12/17 09:53:33 mikpe Exp $
+%%
+
+-include_lib("kernel/include/file.hrl").
+
+-ifndef(SERVER_SOFTWARE).
+-define(SERVER_SOFTWARE,"inets/develop"). % Define in Makefile!
+-endif.
+-define(SERVER_PROTOCOL,"HTTP/1.1").
+-define(SOCKET_CHUNK_SIZE,8192).
+-define(SOCKET_MAX_POLL,25).
+-define(FILE_CHUNK_SIZE,64*1024).
+-define(NICE(Reason),lists:flatten(atom_to_list(?MODULE)++": "++Reason)).
+-define(DEFAULT_CONTEXT,
+ [{errmsg,"[an error occurred while processing this directive]"},
+ {timefmt,"%A, %d-%b-%y %T %Z"},
+ {sizefmt,"abbrev"}]).
+
+
+-ifdef(inets_error).
+-define(ERROR(Format, Args), io:format("E(~p:~p:~p) : "++Format++"~n",
+ [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(ERROR(F,A),[]).
+-endif.
+
+-ifdef(inets_log).
+-define(LOG(Format, Args), io:format("L(~p:~p:~p) : "++Format++"~n",
+ [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(LOG(F,A),[]).
+-endif.
+
+-ifdef(inets_debug).
+-define(DEBUG(Format, Args), io:format("D(~p:~p:~p) : "++Format++"~n",
+ [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(DEBUG(F,A),[]).
+-endif.
+
+-ifdef(inets_cdebug).
+-define(CDEBUG(Format, Args), io:format("C(~p:~p:~p) : "++Format++"~n",
+ [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(CDEBUG(F,A),[]).
+-endif.
+
+
+-record(init_data,{peername,resolve}).
+-record(mod,{init_data,
+ data=[],
+ socket_type=ip_comm,
+ socket,
+ config_db,
+ method,
+ absolute_uri=[],
+ request_uri,
+ http_version,
+ request_line,
+ parsed_header=[],
+ entity_body,
+ connection}).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor.erl
new file mode 100644
index 0000000000..9b88f84865
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor.erl
@@ -0,0 +1,176 @@
+%% ``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: httpd_acceptor.erl,v 1.1 2008/12/17 09:53:33 mikpe Exp $
+%%
+-module(httpd_acceptor).
+
+-include("httpd.hrl").
+-include("httpd_verbosity.hrl").
+
+
+%% External API
+-export([start_link/6]).
+
+%% Other exports (for spawn's etc.)
+-export([acceptor/4, acceptor/7]).
+
+
+%%
+%% External API
+%%
+
+%% start_link
+
+start_link(Manager, SocketType, Addr, Port, ConfigDb, Verbosity) ->
+ Args = [self(), Manager, SocketType, Addr, Port, ConfigDb, Verbosity],
+ proc_lib:start_link(?MODULE, acceptor, Args).
+
+
+acceptor(Parent, Manager, SocketType, Addr, Port, ConfigDb, Verbosity) ->
+ put(sname,acc),
+ put(verbosity,Verbosity),
+ ?vlog("starting",[]),
+ case (catch do_init(SocketType, Addr, Port)) of
+ {ok, ListenSocket} ->
+ proc_lib:init_ack(Parent, {ok, self()}),
+ acceptor(Manager, SocketType, ListenSocket, ConfigDb);
+ Error ->
+ proc_lib:init_ack(Parent, Error),
+ error
+ end.
+
+do_init(SocketType, Addr, Port) ->
+ do_socket_start(SocketType),
+ ListenSocket = do_socket_listen(SocketType, Addr, Port),
+ {ok, ListenSocket}.
+
+
+do_socket_start(SocketType) ->
+ case httpd_socket:start(SocketType) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ ?vinfo("failed socket start: ~p",[Reason]),
+ throw({error, {socket_start_failed, Reason}})
+ end.
+
+
+do_socket_listen(SocketType, Addr, Port) ->
+ case httpd_socket:listen(SocketType, Addr, Port) of
+ {error, Reason} ->
+ ?vinfo("failed socket listen operation: ~p", [Reason]),
+ throw({error, {listen, Reason}});
+ ListenSocket ->
+ ListenSocket
+ end.
+
+
+%% acceptor
+
+acceptor(Manager, SocketType, ListenSocket, ConfigDb) ->
+ ?vdebug("await connection",[]),
+ case (catch httpd_socket:accept(SocketType, ListenSocket, 30000)) of
+ {error, Reason} ->
+ handle_error(Reason, ConfigDb, SocketType),
+ ?MODULE:acceptor(Manager, SocketType, ListenSocket, ConfigDb);
+
+ {'EXIT', Reason} ->
+ handle_error({'EXIT', Reason}, ConfigDb, SocketType),
+ ?MODULE:acceptor(Manager, SocketType, ListenSocket, ConfigDb);
+
+ Socket ->
+ handle_connection(Manager, ConfigDb, SocketType, Socket),
+ ?MODULE:acceptor(Manager, SocketType, ListenSocket, ConfigDb)
+ end.
+
+
+handle_connection(Manager, ConfigDb, SocketType, Socket) ->
+ case httpd_request_handler:start_link(Manager, ConfigDb) of
+ {ok, Pid} ->
+ httpd_socket:controlling_process(SocketType, Socket, Pid),
+ httpd_request_handler:synchronize(Pid, SocketType, Socket);
+ {error, Reason} ->
+ handle_connection_err(SocketType, Socket, ConfigDb, Reason)
+ end.
+
+
+handle_connection_err(SocketType, Socket, ConfigDb, Reason) ->
+ String =
+ lists:flatten(
+ io_lib:format("failed starting request handler:~n ~p", [Reason])),
+ report_error(ConfigDb, String),
+ httpd_socket:close(SocketType, Socket).
+
+
+handle_error(timeout, _, _) ->
+ ?vtrace("Accept timeout",[]),
+ ok;
+
+handle_error({enfile, _}, _, _) ->
+ ?vinfo("Accept error: enfile",[]),
+ %% Out of sockets...
+ sleep(200);
+
+handle_error(emfile, _, _) ->
+ ?vinfo("Accept error: emfile",[]),
+ %% Too many open files -> Out of sockets...
+ sleep(200);
+
+handle_error(closed, _, _) ->
+ ?vlog("Accept error: closed",[]),
+ %% This propably only means that the application is stopping,
+ %% but just in case
+ exit(closed);
+
+handle_error(econnaborted, _, _) ->
+ ?vlog("Accept aborted",[]),
+ ok;
+
+handle_error(esslaccept, _, _) ->
+ %% The user has selected to cancel the installation of
+ %% the certifikate, This is not a real error, so we do
+ %% not write an error message.
+ ok;
+
+handle_error({'EXIT', Reason}, ConfigDb, SocketType) ->
+ ?vinfo("Accept exit:~n ~p",[Reason]),
+ String = lists:flatten(io_lib:format("Accept exit: ~p", [Reason])),
+ accept_failed(SocketType, ConfigDb, String);
+
+handle_error(Reason, ConfigDb, SocketType) ->
+ ?vinfo("Accept error:~n ~p",[Reason]),
+ String = lists:flatten(io_lib:format("Accept error: ~p", [Reason])),
+ accept_failed(SocketType, ConfigDb, String).
+
+
+accept_failed(SocketType, ConfigDb, String) ->
+ error_logger:error_report(String),
+ mod_log:error_log(SocketType, undefined, ConfigDb,
+ {0, "unknown"}, String),
+ mod_disk_log:error_log(SocketType, undefined, ConfigDb,
+ {0, "unknown"}, String),
+ exit({accept_failed, String}).
+
+
+report_error(Db, String) ->
+ error_logger:error_report(String),
+ mod_log:report_error(Db, String),
+ mod_disk_log:report_error(Db, String).
+
+
+sleep(T) -> receive after T -> ok end.
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor_sup.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor_sup.erl
new file mode 100644
index 0000000000..e408614f1c
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor_sup.erl
@@ -0,0 +1,118 @@
+%% ``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: httpd_acceptor_sup.erl,v 1.1 2008/12/17 09:53:33 mikpe Exp $
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for the Megaco/H.248 application
+%%----------------------------------------------------------------------
+
+-module(httpd_acceptor_sup).
+
+-behaviour(supervisor).
+
+-include("httpd_verbosity.hrl").
+
+%% public
+-export([start/3, stop/1, init/1]).
+
+-export([start_acceptor/4, stop_acceptor/2]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% supervisor callback functions
+
+
+start(Addr, Port, AccSupVerbosity) ->
+ SupName = make_name(Addr, Port),
+ supervisor:start_link({local, SupName}, ?MODULE, [AccSupVerbosity]).
+
+stop(StartArgs) ->
+ ok.
+
+init([Verbosity]) -> % Supervisor
+ do_init(Verbosity);
+init(BadArg) ->
+ {error, {badarg, BadArg}}.
+
+do_init(Verbosity) ->
+ put(verbosity,?vvalidate(Verbosity)),
+ put(sname,acc_sup),
+ ?vlog("starting", []),
+ Flags = {one_for_one, 500, 100},
+ KillAfter = timer:seconds(1),
+ Workers = [],
+ {ok, {Flags, Workers}}.
+
+
+%%----------------------------------------------------------------------
+%% Function: [start|stop]_acceptor/5
+%% Description: Starts a [auth | security] worker (child) process
+%%----------------------------------------------------------------------
+
+start_acceptor(SocketType, Addr, Port, ConfigDb) ->
+ Verbosity = get_acc_verbosity(),
+ start_worker(httpd_acceptor, SocketType, Addr, Port,
+ ConfigDb, Verbosity, self(), []).
+
+stop_acceptor(Addr, Port) ->
+ stop_worker(httpd_acceptor, Addr, Port).
+
+
+%%----------------------------------------------------------------------
+%% Function: start_worker/5
+%% Description: Starts a (permanent) worker (child) process
+%%----------------------------------------------------------------------
+
+start_worker(M, SocketType, Addr, Port, ConfigDB, Verbosity, Manager,
+ Modules) ->
+ SupName = make_name(Addr, Port),
+ Args = [Manager, SocketType, Addr, Port, ConfigDB, Verbosity],
+ Spec = {{M, Addr, Port},
+ {M, start_link, Args},
+ permanent, timer:seconds(1), worker, [M] ++ Modules},
+ supervisor:start_child(SupName, Spec).
+
+
+%%----------------------------------------------------------------------
+%% Function: stop_permanent_worker/3
+%% Description: Stops a permanent worker (child) process
+%%----------------------------------------------------------------------
+
+stop_worker(M, Addr, Port) ->
+ SupName = make_name(Addr, Port),
+ Name = {M, Addr, Port},
+ case supervisor:terminate_child(SupName, Name) of
+ ok ->
+ supervisor:delete_child(SupName, Name);
+ Error ->
+ Error
+ end.
+
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd_acc_sup",Addr,Port).
+
+
+
+get_acc_verbosity() ->
+ get_verbosity(get(acceptor_verbosity)).
+
+get_verbosity(undefined) ->
+ ?default_verbosity;
+get_verbosity(V) ->
+ ?vvalidate(V).
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_conf.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_conf.erl
new file mode 100644
index 0000000000..2c7a747d42
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_conf.erl
@@ -0,0 +1,688 @@
+%% ``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: httpd_conf.erl,v 1.1 2008/12/17 09:53:33 mikpe Exp $
+%%
+-module(httpd_conf).
+-export([load/1, load_mime_types/1,
+ load/2, store/1, store/2,
+ remove_all/1, remove/1,
+ is_directory/1, is_file/1,
+ make_integer/1, clean/1, custom_clean/3, check_enum/2]).
+
+
+-define(VMODULE,"CONF").
+-include("httpd_verbosity.hrl").
+
+%% The configuration data is handled in three (3) phases:
+%% 1. Parse the config file and put all directives into a key-vale
+%% tuple list (load/1).
+%% 2. Traverse the key-value tuple list store it into an ETS table.
+%% Directives depending on other directives are taken care of here
+%% (store/1).
+%% 3. Traverse the ETS table and do a complete clean-up (remove/1).
+
+-include("httpd.hrl").
+
+%%
+%% Phase 1: Load
+%%
+
+%% load
+
+load(ConfigFile) ->
+ ?CDEBUG("load -> ConfigFile: ~p",[ConfigFile]),
+ case read_config_file(ConfigFile) of
+ {ok, Config} ->
+ case bootstrap(Config) of
+ {error, Reason} ->
+ {error, Reason};
+ {ok, Modules} ->
+ load_config(Config, lists:append(Modules, [?MODULE]))
+ end;
+ {error, Reason} ->
+ {error, ?NICE("Error while reading config file: "++Reason)}
+ end.
+
+
+bootstrap([]) ->
+ {error, ?NICE("Modules must be specified in the config file")};
+bootstrap([Line|Config]) ->
+ case Line of
+ [$M,$o,$d,$u,$l,$e,$s,$ |Modules] ->
+ {ok, ModuleList} = regexp:split(Modules," "),
+ TheMods = [list_to_atom(X) || X <- ModuleList],
+ case verify_modules(TheMods) of
+ ok ->
+ {ok, TheMods};
+ {error, Reason} ->
+ ?ERROR("bootstrap -> : validation failed: ~p",[Reason]),
+ {error, Reason}
+ end;
+ _ ->
+ bootstrap(Config)
+ end.
+
+
+%%
+%% verify_modules/1 -> ok | {error, Reason}
+%%
+%% Verifies that all specified modules are available.
+%%
+verify_modules([]) ->
+ ok;
+verify_modules([Mod|Rest]) ->
+ case code:which(Mod) of
+ non_existing ->
+ {error, ?NICE(atom_to_list(Mod)++" does not exist")};
+ Path ->
+ verify_modules(Rest)
+ end.
+
+%%
+%% read_config_file/1 -> {ok, [line(), line()..]} | {error, Reason}
+%%
+%% Reads the entire configuration file and returns list of strings or
+%% and error.
+%%
+
+
+read_config_file(FileName) ->
+ case file:open(FileName, [read]) of
+ {ok, Stream} ->
+ read_config_file(Stream, []);
+ {error, Reason} ->
+ {error, ?NICE("Cannot open "++FileName)}
+ end.
+
+read_config_file(Stream, SoFar) ->
+ case io:get_line(Stream, []) of
+ eof ->
+ {ok, lists:reverse(SoFar)};
+ {error, Reason} ->
+ {error, Reason};
+ [$#|Rest] ->
+ %% Ignore commented lines for efficiency later ..
+ read_config_file(Stream, SoFar);
+ Line ->
+ {ok, NewLine, _}=regexp:sub(clean(Line),"[\t\r\f ]"," "),
+ case NewLine of
+ [] ->
+ %% Also ignore empty lines ..
+ read_config_file(Stream, SoFar);
+ Other ->
+ read_config_file(Stream, [NewLine|SoFar])
+ end
+ end.
+
+is_exported(Module, ToFind) ->
+ Exports = Module:module_info(exports),
+ lists:member(ToFind, Exports).
+
+%%
+%% load/4 -> {ok, ConfigList} | {error, Reason}
+%%
+%% This loads the config file into each module specified by Modules
+%% Each module has its own context that is passed to and (optionally)
+%% returned by the modules load function. The module can also return
+%% a ConfigEntry, which will be added to the global configuration
+%% list.
+%% All configuration directives are guaranteed to be passed to all
+%% modules. Each module only implements the function clauses of
+%% the load function for the configuration directives it supports,
+%% it's ok if an apply returns {'EXIT', {function_clause, ..}}.
+%%
+load_config(Config, Modules) ->
+ %% Create default contexts for all modules
+ Contexts = lists:duplicate(length(Modules), []),
+ load_config(Config, Modules, Contexts, []).
+
+
+load_config([], _Modules, _Contexts, ConfigList) ->
+ case a_must(ConfigList, [server_name,port,server_root,document_root]) of
+ ok ->
+ {ok, ConfigList};
+ {missing, Directive} ->
+ {error, ?NICE(atom_to_list(Directive)++
+ " must be specified in the config file")}
+ end;
+
+load_config([Line|Config], Modules, Contexts, ConfigList) ->
+ ?CDEBUG("load_config -> Line: ~p",[Line]),
+ case load_traverse(Line, Contexts, Modules, [], ConfigList, no) of
+ {ok, NewContexts, NewConfigList} ->
+ load_config(Config, Modules, NewContexts, NewConfigList);
+ {error, Reason} ->
+ ?ERROR("load_config -> traverse failed: ~p",[Reason]),
+ {error, Reason}
+ end.
+
+
+load_traverse(Line, [], [], NewContexts, ConfigList, no) ->
+ ?CDEBUG("load_traverse/no -> ~n"
+ " Line: ~p~n"
+ " NewContexts: ~p~n"
+ " ConfigList: ~p",
+ [Line,NewContexts,ConfigList]),
+ {error, ?NICE("Configuration directive not recognized: "++Line)};
+load_traverse(Line, [], [], NewContexts, ConfigList, yes) ->
+ ?CDEBUG("load_traverse/yes -> ~n"
+ " Line: ~p~n"
+ " NewContexts: ~p~n"
+ " ConfigList: ~p",
+ [Line,NewContexts,ConfigList]),
+ {ok, lists:reverse(NewContexts), ConfigList};
+load_traverse(Line, [Context|Contexts], [Module|Modules], NewContexts, ConfigList, State) ->
+ ?CDEBUG("load_traverse/~p -> ~n"
+ " Line: ~p~n"
+ " Module: ~p~n"
+ " Context: ~p~n"
+ " Contexts: ~p~n"
+ " NewContexts: ~p",
+ [State,Line,Module,Context,Contexts,NewContexts]),
+ case is_exported(Module, {load, 2}) of
+ true ->
+ ?CDEBUG("load_traverse -> ~p:load/2 exported",[Module]),
+ case catch apply(Module, load, [Line, Context]) of
+ {'EXIT', {function_clause, _}} ->
+ ?CDEBUG("load_traverse -> exit: function_clause"
+ "~n Module: ~p"
+ "~n Line: ~s",[Module,Line]),
+ load_traverse(Line, Contexts, Modules, [Context|NewContexts], ConfigList, State);
+ {'EXIT', Reason} ->
+ ?CDEBUG("load_traverse -> exit: ~p",[Reason]),
+ error_logger:error_report({'EXIT', Reason}),
+ load_traverse(Line, Contexts, Modules, [Context|NewContexts], ConfigList, State);
+ {ok, NewContext} ->
+ ?CDEBUG("load_traverse -> ~n"
+ " NewContext: ~p",[NewContext]),
+ load_traverse(Line, Contexts, Modules, [NewContext|NewContexts], ConfigList,yes);
+ {ok, NewContext, ConfigEntry} when tuple(ConfigEntry) ->
+ ?CDEBUG("load_traverse (tuple) -> ~n"
+ " NewContext: ~p~n"
+ " ConfigEntry: ~p",[NewContext,ConfigEntry]),
+ load_traverse(Line, Contexts, Modules, [NewContext|NewContexts],
+ [ConfigEntry|ConfigList], yes);
+ {ok, NewContext, ConfigEntry} when list(ConfigEntry) ->
+ ?CDEBUG("load_traverse (list) -> ~n"
+ " NewContext: ~p~n"
+ " ConfigEntry: ~p",[NewContext,ConfigEntry]),
+ load_traverse(Line, Contexts, Modules, [NewContext|NewContexts],
+ lists:append(ConfigEntry, ConfigList), yes);
+ {error, Reason} ->
+ ?CDEBUG("load_traverse -> error: ~p",[Reason]),
+ {error, Reason}
+ end;
+ false ->
+ ?CDEBUG("load_traverse -> ~p:load/2 not exported",[Module]),
+ load_traverse(Line, Contexts, Modules, [Context|NewContexts],
+ ConfigList,yes)
+ end.
+
+
+load(eof, []) ->
+ eof;
+
+load([$M,$a,$x,$H,$e,$a,$d,$e,$r,$S,$i,$z,$e,$ |MaxHeaderSize], []) ->
+ ?DEBUG("load -> MaxHeaderSize: ~p",[MaxHeaderSize]),
+ case make_integer(MaxHeaderSize) of
+ {ok, Integer} ->
+ {ok, [], {max_header_size,Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(MaxHeaderSize)++
+ " is an invalid number of MaxHeaderSize")}
+ end;
+load([$M,$a,$x,$H,$e,$a,$d,$e,$r,$A,$c,$t,$i,$o,$n,$ |Action], []) ->
+ ?DEBUG("load -> MaxHeaderAction: ~p",[Action]),
+ {ok, [], {max_header_action,list_to_atom(clean(Action))}};
+load([$M,$a,$x,$B,$o,$d,$y,$S,$i,$z,$e,$ |MaxBodySize], []) ->
+ ?DEBUG("load -> MaxBodySize: ~p",[MaxBodySize]),
+ case make_integer(MaxBodySize) of
+ {ok, Integer} ->
+ {ok, [], {max_body_size,Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(MaxBodySize)++
+ " is an invalid number of MaxBodySize")}
+ end;
+load([$M,$a,$x,$B,$o,$d,$y,$A,$c,$t,$i,$o,$n,$ |Action], []) ->
+ ?DEBUG("load -> MaxBodyAction: ~p",[Action]),
+ {ok, [], {max_body_action,list_to_atom(clean(Action))}};
+load([$S,$e,$r,$v,$e,$r,$N,$a,$m,$e,$ |ServerName], []) ->
+ ?DEBUG("load -> ServerName: ~p",[ServerName]),
+ {ok,[],{server_name,clean(ServerName)}};
+load([$S,$o,$c,$k,$e,$t,$T,$y,$p,$e,$ |SocketType], []) ->
+ ?DEBUG("load -> SocketType: ~p",[SocketType]),
+ case check_enum(clean(SocketType),["ssl","ip_comm"]) of
+ {ok, ValidSocketType} ->
+ {ok, [], {com_type,ValidSocketType}};
+ {error,_} ->
+ {error, ?NICE(clean(SocketType) ++ " is an invalid SocketType")}
+ end;
+load([$P,$o,$r,$t,$ |Port], []) ->
+ ?DEBUG("load -> Port: ~p",[Port]),
+ case make_integer(Port) of
+ {ok, Integer} ->
+ {ok, [], {port,Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(Port)++" is an invalid Port")}
+ end;
+load([$B,$i,$n,$d,$A,$d,$d,$r,$e,$s,$s,$ |Address], []) ->
+ ?DEBUG("load -> Address: ~p",[Address]),
+ case clean(Address) of
+ "*" ->
+ {ok, [], {bind_address,any}};
+ CAddress ->
+ ?CDEBUG("load -> CAddress: ~p",[CAddress]),
+ case inet:getaddr(CAddress,inet) of
+ {ok, IPAddr} ->
+ ?CDEBUG("load -> IPAddr: ~p",[IPAddr]),
+ {ok, [], {bind_address,IPAddr}};
+ {error, _} ->
+ {error, ?NICE(CAddress++" is an invalid address")}
+ end
+ end;
+load([$K,$e,$e,$p,$A,$l,$i,$v,$e,$ |OnorOff], []) ->
+ case list_to_atom(clean(OnorOff)) of
+ off ->
+ {ok, [], {persistent_conn, false}};
+ _ ->
+ {ok, [], {persistent_conn, true}}
+ end;
+load([$M,$a,$x,$K,$e,$e,$p,$A,$l,$i,$v,$e,$R,$e,$q,$u,$e,$s,$t,$ |MaxRequests], []) ->
+ case make_integer(MaxRequests) of
+ {ok, Integer} ->
+ {ok, [], {max_keep_alive_request, Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(MaxRequests)++" is an invalid MaxKeepAliveRequest")}
+ end;
+load([$K,$e,$e,$p,$A,$l,$i,$v,$e,$T,$i,$m,$e,$o,$u,$t,$ |Timeout], []) ->
+ case make_integer(Timeout) of
+ {ok, Integer} ->
+ {ok, [], {keep_alive_timeout, Integer*1000}};
+ {error, _} ->
+ {error, ?NICE(clean(Timeout)++" is an invalid KeepAliveTimeout")}
+ end;
+load([$M,$o,$d,$u,$l,$e,$s,$ |Modules], []) ->
+ {ok, ModuleList} = regexp:split(Modules," "),
+ {ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}};
+load([$S,$e,$r,$v,$e,$r,$A,$d,$m,$i,$n,$ |ServerAdmin], []) ->
+ {ok, [], {server_admin,clean(ServerAdmin)}};
+load([$S,$e,$r,$v,$e,$r,$R,$o,$o,$t,$ |ServerRoot], []) ->
+ case is_directory(clean(ServerRoot)) of
+ {ok, Directory} ->
+ MimeTypesFile =
+ filename:join([clean(ServerRoot),"conf", "mime.types"]),
+ case load_mime_types(MimeTypesFile) of
+ {ok, MimeTypesList} ->
+ {ok, [], [{server_root,string:strip(Directory,right,$/)},
+ {mime_types,MimeTypesList}]};
+ {error, Reason} ->
+ {error, Reason}
+ end;
+ {error, _} ->
+ {error, ?NICE(clean(ServerRoot)++" is an invalid ServerRoot")}
+ end;
+load([$M,$a,$x,$C,$l,$i,$e,$n,$t,$s,$ |MaxClients], []) ->
+ ?DEBUG("load -> MaxClients: ~p",[MaxClients]),
+ case make_integer(MaxClients) of
+ {ok, Integer} ->
+ {ok, [], {max_clients,Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(MaxClients)++" is an invalid number of MaxClients")}
+ end;
+load([$D,$o,$c,$u,$m,$e,$n,$t,$R,$o,$o,$t,$ |DocumentRoot],[]) ->
+ case is_directory(clean(DocumentRoot)) of
+ {ok, Directory} ->
+ {ok, [], {document_root,string:strip(Directory,right,$/)}};
+ {error, _} ->
+ {error, ?NICE(clean(DocumentRoot)++"is an invalid DocumentRoot")}
+ end;
+load([$D,$e,$f,$a,$u,$l,$t,$T,$y,$p,$e,$ |DefaultType], []) ->
+ {ok, [], {default_type,clean(DefaultType)}};
+load([$S,$S,$L,$C,$e,$r,$t,$i,$f,$i,$c,$a,$t,$e,$F,$i,$l,$e,$ | SSLCertificateFile], []) ->
+ ?DEBUG("load -> SSLCertificateFile: ~p",[SSLCertificateFile]),
+ case is_file(clean(SSLCertificateFile)) of
+ {ok, File} ->
+ {ok, [], {ssl_certificate_file,File}};
+ {error, _} ->
+ {error, ?NICE(clean(SSLCertificateFile)++
+ " is an invalid SSLCertificateFile")}
+ end;
+load([$S,$S,$L,$C,$e,$r,$t,$i,$f,$i,$c,$a,$t,$e,$K,$e,$y,$F,$i,$l,$e,$ |
+ SSLCertificateKeyFile], []) ->
+ ?DEBUG("load -> SSLCertificateKeyFile: ~p",[SSLCertificateKeyFile]),
+ case is_file(clean(SSLCertificateKeyFile)) of
+ {ok, File} ->
+ {ok, [], {ssl_certificate_key_file,File}};
+ {error, _} ->
+ {error, ?NICE(clean(SSLCertificateKeyFile)++
+ " is an invalid SSLCertificateKeyFile")}
+ end;
+load([$S,$S,$L,$V,$e,$r,$i,$f,$y,$C,$l,$i,$e,$n,$t,$ |SSLVerifyClient], []) ->
+ ?DEBUG("load -> SSLVerifyClient: ~p",[SSLVerifyClient]),
+ case make_integer(clean(SSLVerifyClient)) of
+ {ok, Integer} when Integer >=0,Integer =< 2 ->
+ {ok, [], {ssl_verify_client,Integer}};
+ {ok, Integer} ->
+ {error,?NICE(clean(SSLVerifyClient)++" is an invalid SSLVerifyClient")};
+ {error, nomatch} ->
+ {error,?NICE(clean(SSLVerifyClient)++" is an invalid SSLVerifyClient")}
+ end;
+load([$S,$S,$L,$V,$e,$r,$i,$f,$y,$D,$e,$p,$t,$h,$ |
+ SSLVerifyDepth], []) ->
+ ?DEBUG("load -> SSLVerifyDepth: ~p",[SSLVerifyDepth]),
+ case make_integer(clean(SSLVerifyDepth)) of
+ {ok, Integer} when Integer > 0 ->
+ {ok, [], {ssl_verify_client_depth,Integer}};
+ {ok, Integer} ->
+ {error,?NICE(clean(SSLVerifyDepth) ++
+ " is an invalid SSLVerifyDepth")};
+ {error, nomatch} ->
+ {error,?NICE(clean(SSLVerifyDepth) ++
+ " is an invalid SSLVerifyDepth")}
+ end;
+load([$S,$S,$L,$C,$i,$p,$h,$e,$r,$s,$ | SSLCiphers], []) ->
+ ?DEBUG("load -> SSLCiphers: ~p",[SSLCiphers]),
+ {ok, [], {ssl_ciphers, clean(SSLCiphers)}};
+load([$S,$S,$L,$C,$A,$C,$e,$r,$t,$i,$f,$i,$c,$a,$t,$e,$F,$i,$l,$e,$ |
+ SSLCACertificateFile], []) ->
+ case is_file(clean(SSLCACertificateFile)) of
+ {ok, File} ->
+ {ok, [], {ssl_ca_certificate_file,File}};
+ {error, _} ->
+ {error, ?NICE(clean(SSLCACertificateFile)++
+ " is an invalid SSLCACertificateFile")}
+ end;
+load([$S,$S,$L,$P,$a,$s,$s,$w,$o,$r,$d,$C,$a,$l,$l,$b,$a,$c,$k,$M,$o,$d,$u,$l,$e,$ | SSLPasswordCallbackModule], []) ->
+ ?DEBUG("load -> SSLPasswordCallbackModule: ~p",
+ [SSLPasswordCallbackModule]),
+ {ok, [], {ssl_password_callback_module,
+ list_to_atom(clean(SSLPasswordCallbackModule))}};
+load([$S,$S,$L,$P,$a,$s,$s,$w,$o,$r,$d,$C,$a,$l,$l,$b,$a,$c,$k,$F,$u,$n,$c,$t,$i,$o,$n,$ | SSLPasswordCallbackFunction], []) ->
+ ?DEBUG("load -> SSLPasswordCallbackFunction: ~p",
+ [SSLPasswordCallbackFunction]),
+ {ok, [], {ssl_password_callback_function,
+ list_to_atom(clean(SSLPasswordCallbackFunction))}}.
+
+
+%%
+%% load_mime_types/1 -> {ok, MimeTypes} | {error, Reason}
+%%
+load_mime_types(MimeTypesFile) ->
+ case file:open(MimeTypesFile, [read]) of
+ {ok, Stream} ->
+ parse_mime_types(Stream, []);
+ {error, _} ->
+ {error, ?NICE("Can't open " ++ MimeTypesFile)}
+ end.
+
+parse_mime_types(Stream,MimeTypesList) ->
+ Line=
+ case io:get_line(Stream,'') of
+ eof ->
+ eof;
+ String ->
+ clean(String)
+ end,
+ parse_mime_types(Stream, MimeTypesList, Line).
+
+parse_mime_types(Stream, MimeTypesList, eof) ->
+ file:close(Stream),
+ {ok, MimeTypesList};
+parse_mime_types(Stream, MimeTypesList, "") ->
+ parse_mime_types(Stream, MimeTypesList);
+parse_mime_types(Stream, MimeTypesList, [$#|_]) ->
+ parse_mime_types(Stream, MimeTypesList);
+parse_mime_types(Stream, MimeTypesList, Line) ->
+ case regexp:split(Line, " ") of
+ {ok, [NewMimeType|Suffixes]} ->
+ parse_mime_types(Stream,lists:append(suffixes(NewMimeType,Suffixes),
+ MimeTypesList));
+ {ok, _} ->
+ {error, ?NICE(Line)}
+ end.
+
+suffixes(MimeType,[]) ->
+ [];
+suffixes(MimeType,[Suffix|Rest]) ->
+ [{Suffix,MimeType}|suffixes(MimeType,Rest)].
+
+%%
+%% Phase 2: Store
+%%
+
+%% store
+
+store(ConfigList) ->
+ Modules = httpd_util:key1search(ConfigList, modules, []),
+ Port = httpd_util:key1search(ConfigList, port),
+ Addr = httpd_util:key1search(ConfigList,bind_address),
+ Name = httpd_util:make_name("httpd_conf",Addr,Port),
+ ?CDEBUG("store -> Name = ~p",[Name]),
+ ConfigDB = ets:new(Name, [named_table, bag, protected]),
+ ?CDEBUG("store -> ConfigDB = ~p",[ConfigDB]),
+ store(ConfigDB, ConfigList, lists:append(Modules,[?MODULE]),ConfigList).
+
+store(ConfigDB, ConfigList, Modules,[]) ->
+ ?vtrace("store -> done",[]),
+ ?CDEBUG("store -> done",[]),
+ {ok, ConfigDB};
+store(ConfigDB, ConfigList, Modules, [ConfigListEntry|Rest]) ->
+ ?vtrace("store -> entry with"
+ "~n ConfigListEntry: ~p",[ConfigListEntry]),
+ ?CDEBUG("store -> "
+ "~n ConfigListEntry: ~p",[ConfigListEntry]),
+ case store_traverse(ConfigListEntry,ConfigList,Modules) of
+ {ok, ConfigDBEntry} when tuple(ConfigDBEntry) ->
+ ?vtrace("store -> ConfigDBEntry(tuple): "
+ "~n ~p",[ConfigDBEntry]),
+ ?CDEBUG("store -> ConfigDBEntry(tuple): "
+ "~n ~p",[ConfigDBEntry]),
+ ets:insert(ConfigDB,ConfigDBEntry),
+ store(ConfigDB,ConfigList,Modules,Rest);
+ {ok, ConfigDBEntry} when list(ConfigDBEntry) ->
+ ?vtrace("store -> ConfigDBEntry(list): "
+ "~n ~p",[ConfigDBEntry]),
+ ?CDEBUG("store -> ConfigDBEntry(list): "
+ "~n ~p",[ConfigDBEntry]),
+ lists:foreach(fun(Entry) ->
+ ets:insert(ConfigDB,Entry)
+ end,ConfigDBEntry),
+ store(ConfigDB,ConfigList,Modules,Rest);
+ {error, Reason} ->
+ ?vlog("store -> error: ~p",[Reason]),
+ ?ERROR("store -> error: ~p",[Reason]),
+ {error,Reason}
+ end.
+
+store_traverse(ConfigListEntry,ConfigList,[]) ->
+ {error,?NICE("Unable to store configuration...")};
+store_traverse(ConfigListEntry, ConfigList, [Module|Rest]) ->
+ case is_exported(Module, {store, 2}) of
+ true ->
+ ?CDEBUG("store_traverse -> call ~p:store/2",[Module]),
+ case catch apply(Module,store,[ConfigListEntry, ConfigList]) of
+ {'EXIT',{function_clause,_}} ->
+ ?CDEBUG("store_traverse -> exit: function_clause",[]),
+ store_traverse(ConfigListEntry,ConfigList,Rest);
+ {'EXIT',Reason} ->
+ ?ERROR("store_traverse -> exit: ~p",[Reason]),
+ error_logger:error_report({'EXIT',Reason}),
+ store_traverse(ConfigListEntry,ConfigList,Rest);
+ Result ->
+ ?CDEBUG("store_traverse -> ~n"
+ " Result: ~p",[Result]),
+ Result
+ end;
+ false ->
+ store_traverse(ConfigListEntry,ConfigList,Rest)
+ end.
+
+store({mime_types,MimeTypesList},ConfigList) ->
+ Port = httpd_util:key1search(ConfigList, port),
+ Addr = httpd_util:key1search(ConfigList, bind_address),
+ Name = httpd_util:make_name("httpd_mime",Addr,Port),
+ ?CDEBUG("store(mime_types) -> Name: ~p",[Name]),
+ {ok, MimeTypesDB} = store_mime_types(Name,MimeTypesList),
+ ?CDEBUG("store(mime_types) -> ~n"
+ " MimeTypesDB: ~p~n"
+ " MimeTypesDB info: ~p",
+ [MimeTypesDB,ets:info(MimeTypesDB)]),
+ {ok, {mime_types,MimeTypesDB}};
+store(ConfigListEntry,ConfigList) ->
+ ?CDEBUG("store/2 -> ~n"
+ " ConfigListEntry: ~p~n"
+ " ConfigList: ~p",
+ [ConfigListEntry,ConfigList]),
+ {ok, ConfigListEntry}.
+
+
+%% store_mime_types
+store_mime_types(Name,MimeTypesList) ->
+ ?CDEBUG("store_mime_types -> Name: ~p",[Name]),
+ MimeTypesDB = ets:new(Name, [set, protected]),
+ ?CDEBUG("store_mime_types -> MimeTypesDB: ~p",[MimeTypesDB]),
+ store_mime_types1(MimeTypesDB, MimeTypesList).
+
+store_mime_types1(MimeTypesDB,[]) ->
+ {ok, MimeTypesDB};
+store_mime_types1(MimeTypesDB,[Type|Rest]) ->
+ ?CDEBUG("store_mime_types1 -> Type: ~p",[Type]),
+ ets:insert(MimeTypesDB, Type),
+ store_mime_types1(MimeTypesDB, Rest).
+
+
+%%
+%% Phase 3: Remove
+%%
+
+remove_all(ConfigDB) ->
+ Modules = httpd_util:lookup(ConfigDB,modules,[]),
+ remove_traverse(ConfigDB, lists:append(Modules,[?MODULE])).
+
+remove_traverse(ConfigDB,[]) ->
+ ?vtrace("remove_traverse -> done", []),
+ ok;
+remove_traverse(ConfigDB,[Module|Rest]) ->
+ ?vtrace("remove_traverse -> call ~p:remove", [Module]),
+ case (catch apply(Module,remove,[ConfigDB])) of
+ {'EXIT',{undef,_}} ->
+ ?vtrace("remove_traverse -> undef", []),
+ remove_traverse(ConfigDB,Rest);
+ {'EXIT',{function_clause,_}} ->
+ ?vtrace("remove_traverse -> function_clause", []),
+ remove_traverse(ConfigDB,Rest);
+ {'EXIT',Reason} ->
+ ?vtrace("remove_traverse -> exit: ~p", [Reason]),
+ error_logger:error_report({'EXIT',Reason}),
+ remove_traverse(ConfigDB,Rest);
+ {error,Reason} ->
+ ?vtrace("remove_traverse -> error: ~p", [Reason]),
+ error_logger:error_report(Reason),
+ remove_traverse(ConfigDB,Rest);
+ _ ->
+ remove_traverse(ConfigDB,Rest)
+ end.
+
+remove(ConfigDB) ->
+ ets:delete(ConfigDB),
+ ok.
+
+
+%%
+%% Utility functions
+%%
+
+%% is_directory
+
+is_directory(Directory) ->
+ case file:read_file_info(Directory) of
+ {ok,FileInfo} ->
+ #file_info{type = Type, access = Access} = FileInfo,
+ is_directory(Type,Access,FileInfo,Directory);
+ {error,Reason} ->
+ {error,Reason}
+ end.
+
+is_directory(directory,read,_FileInfo,Directory) ->
+ {ok,Directory};
+is_directory(directory,read_write,_FileInfo,Directory) ->
+ {ok,Directory};
+is_directory(_Type,_Access,FileInfo,_Directory) ->
+ {error,FileInfo}.
+
+
+%% is_file
+
+is_file(File) ->
+ case file:read_file_info(File) of
+ {ok,FileInfo} ->
+ #file_info{type = Type, access = Access} = FileInfo,
+ is_file(Type,Access,FileInfo,File);
+ {error,Reason} ->
+ {error,Reason}
+ end.
+
+is_file(regular,read,_FileInfo,File) ->
+ {ok,File};
+is_file(regular,read_write,_FileInfo,File) ->
+ {ok,File};
+is_file(_Type,_Access,FileInfo,_File) ->
+ {error,FileInfo}.
+
+%% make_integer
+
+make_integer(String) ->
+ case regexp:match(clean(String),"[0-9]+") of
+ {match, _, _} ->
+ {ok, list_to_integer(clean(String))};
+ nomatch ->
+ {error, nomatch}
+ end.
+
+
+%% clean
+
+clean(String) ->
+ {ok,CleanedString,_} = regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""),
+ CleanedString.
+
+%% custom_clean
+
+custom_clean(String,MoreBefore,MoreAfter) ->
+ {ok,CleanedString,_}=regexp:gsub(String,"^[ \t\n\r\f"++MoreBefore++
+ "]*|[ \t\n\r\f"++MoreAfter++"]*\$",""),
+ CleanedString.
+
+%% check_enum
+
+check_enum(Enum,[]) ->
+ {error, not_valid};
+check_enum(Enum,[Enum|Rest]) ->
+ {ok, list_to_atom(Enum)};
+check_enum(Enum, [NotValid|Rest]) ->
+ check_enum(Enum, Rest).
+
+%% a_must
+
+a_must(ConfigList,[]) ->
+ ok;
+a_must(ConfigList,[Directive|Rest]) ->
+ case httpd_util:key1search(ConfigList,Directive) of
+ undefined ->
+ {missing,Directive};
+ _ ->
+ a_must(ConfigList,Rest)
+ end.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_example.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_example.erl
new file mode 100644
index 0000000000..1819650963
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_example.erl
@@ -0,0 +1,134 @@
+%% ``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: httpd_example.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(httpd_example).
+-export([print/1]).
+-export([get/2, post/2, yahoo/2, test1/2]).
+
+-export([newformat/3]).
+%% These are used by the inets test-suite
+-export([delay/1]).
+
+
+print(String) ->
+ [header(),
+ top("Print"),
+ String++"\n",
+ footer()].
+
+
+test1(Env, []) ->
+ io:format("Env:~p~n",[Env]),
+ ["<html>",
+ "<head>",
+ "<title>Test1</title>",
+ "</head>",
+ "<body>",
+ "<h1>Erlang Body</h1>",
+ "<h2>Stuff</h2>",
+ "</body>",
+ "</html>"].
+
+
+get(Env,[]) ->
+ [header(),
+ top("GET Example"),
+ "<FORM ACTION=\"/cgi-bin/erl/httpd_example:get\" METHOD=GET>
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n",
+ footer()];
+
+get(Env,Input) ->
+ default(Env,Input).
+
+post(Env,[]) ->
+ [header(),
+ top("POST Example"),
+ "<FORM ACTION=\"/cgi-bin/erl/httpd_example:post\" METHOD=POST>
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n",
+ footer()];
+
+post(Env,Input) ->
+ default(Env,Input).
+
+yahoo(Env,Input) ->
+ "Location: http://www.yahoo.com\r\n\r\n".
+
+default(Env,Input) ->
+ [header(),
+ top("Default Example"),
+ "<B>Environment:</B> ",io_lib:format("~p",[Env]),"<BR>\n",
+ "<B>Input:</B> ",Input,"<BR>\n",
+ "<B>Parsed Input:</B> ",
+ io_lib:format("~p",[httpd:parse_query(Input)]),"\n",
+ footer()].
+
+header() ->
+ header("text/html").
+header(MimeType) ->
+ "Content-type: " ++ MimeType ++ "\r\n\r\n".
+
+top(Title) ->
+ "<HTML>
+<HEAD>
+<TITLE>" ++ Title ++ "</TITLE>
+</HEAD>
+<BODY>\n".
+
+footer() ->
+ "</BODY>
+</HTML>\n".
+
+
+newformat(SessionID,Env,Input)->
+ mod_esi:deliver(SessionID,"Content-Type:text/html\r\n\r\n"),
+ mod_esi:deliver(SessionID,top("new esi format test")),
+ mod_esi:deliver(SessionID,"This new format is nice<BR>"),
+ mod_esi:deliver(SessionID,"This new format is nice<BR>"),
+ mod_esi:deliver(SessionID,"This new format is nice<BR>"),
+ mod_esi:deliver(SessionID,footer()).
+
+%% ------------------------------------------------------
+
+delay(Time) when integer(Time) ->
+ i("httpd_example:delay(~p) -> do the delay",[Time]),
+ sleep(Time),
+ i("httpd_example:delay(~p) -> done, now reply",[Time]),
+ delay_reply("delay ok");
+delay(Time) when list(Time) ->
+ delay(httpd_conf:make_integer(Time));
+delay({ok,Time}) when integer(Time) ->
+ delay(Time);
+delay({error,_Reason}) ->
+ i("delay -> called with invalid time"),
+ delay_reply("delay failed: invalid delay time").
+
+delay_reply(Reply) ->
+ [header(),
+ top("delay"),
+ Reply,
+ footer()].
+
+i(F) -> i(F,[]).
+i(F,A) -> io:format(F ++ "~n",A).
+
+sleep(T) -> receive after T -> ok end.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_manager.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_manager.erl
new file mode 100644
index 0000000000..78750c32c9
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_manager.erl
@@ -0,0 +1,1030 @@
+%% ``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: httpd_manager.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+
+-module(httpd_manager).
+
+-include("httpd.hrl").
+-include("httpd_verbosity.hrl").
+
+-behaviour(gen_server).
+
+%% External API
+-export([start/2, start/3, start_link/2, start_link/3, stop/1, restart/1]).
+
+%% Internal API
+-export([new_connection/1, done_connection/1]).
+
+%% Module API
+-export([config_lookup/2, config_lookup/3,
+ config_multi_lookup/2, config_multi_lookup/3,
+ config_match/2, config_match/3]).
+
+%% gen_server exports
+-export([init/1,
+ handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2,
+ code_change/3]).
+
+
+%% Management exports
+-export([block/2, block/3, unblock/1]).
+-export([get_admin_state/1, get_usage_state/1]).
+-export([is_busy/1,is_busy/2,is_busy_or_blocked/1,is_blocked/1]). %% ???????
+-export([get_status/1, get_status/2]).
+-export([verbosity/2, verbosity/3]).
+
+
+-export([c/1]).
+
+-record(state,{socket_type = ip_comm,
+ config_file,
+ config_db = null,
+ connections, %% Current request handlers
+ admin_state = unblocked,
+ blocker_ref = undefined,
+ blocking_tmr = undefined,
+ status = []}).
+
+
+c(Port) ->
+ Ref = httpd_util:make_name("httpd",undefined,Port),
+ gen_server:call(Ref, fake_close).
+
+
+%%
+%% External API
+%%
+
+start(ConfigFile, ConfigList) ->
+ start(ConfigFile, ConfigList, []).
+
+start(ConfigFile, ConfigList, Verbosity) ->
+ Port = httpd_util:key1search(ConfigList,port,80),
+ Addr = httpd_util:key1search(ConfigList,bind_address),
+ Name = make_name(Addr,Port),
+ ?LOG("start -> Name = ~p",[Name]),
+ gen_server:start({local,Name},?MODULE,
+ [ConfigFile, ConfigList, Addr, Port, Verbosity],[]).
+
+start_link(ConfigFile, ConfigList) ->
+ start_link(ConfigFile, ConfigList, []).
+
+start_link(ConfigFile, ConfigList, Verbosity) ->
+ Port = httpd_util:key1search(ConfigList,port,80),
+ Addr = httpd_util:key1search(ConfigList,bind_address),
+ Name = make_name(Addr,Port),
+ ?LOG("start_link -> Name = ~p",[Name]),
+ gen_server:start_link({local, Name},?MODULE,
+ [ConfigFile, ConfigList, Addr, Port, Verbosity],[]).
+
+%% stop
+
+stop(ServerRef) ->
+ gen_server:call(ServerRef, stop).
+
+%% restart
+
+restart(ServerRef) ->
+ gen_server:call(ServerRef, restart).
+
+
+%%%----------------------------------------------------------------
+
+block(ServerRef, disturbing) ->
+ call(ServerRef,block);
+
+block(ServerRef, non_disturbing) ->
+ do_block(ServerRef, non_disturbing, infinity).
+
+block(ServerRef, Method, Timeout) ->
+ do_block(ServerRef, Method, Timeout).
+
+
+%% The reason for not using call here, is that the manager cannot
+%% _wait_ for completion of the requests. It must be able to do
+%% do other things at the same time as the blocking goes on.
+do_block(ServerRef, Method, infinity) ->
+ Ref = make_ref(),
+ cast(ServerRef, {block, Method, infinity, self(), Ref}),
+ receive
+ {block_reply, Reply, Ref} ->
+ Reply
+ end;
+do_block(ServerRef,Method,Timeout) when Timeout > 0 ->
+ Ref = make_ref(),
+ cast(ServerRef,{block,Method,Timeout,self(),Ref}),
+ receive
+ {block_reply,Reply,Ref} ->
+ Reply
+ end.
+
+
+%%%----------------------------------------------------------------
+
+%% unblock
+
+unblock(ServerRef) ->
+ call(ServerRef,unblock).
+
+%% get admin/usage state
+
+get_admin_state(ServerRef) ->
+ call(ServerRef,get_admin_state).
+
+get_usage_state(ServerRef) ->
+ call(ServerRef,get_usage_state).
+
+
+%% get_status
+
+get_status(ServerRef) ->
+ gen_server:call(ServerRef,get_status).
+
+get_status(ServerRef,Timeout) ->
+ gen_server:call(ServerRef,get_status,Timeout).
+
+
+verbosity(ServerRef,Verbosity) ->
+ verbosity(ServerRef,all,Verbosity).
+
+verbosity(ServerRef,all,Verbosity) ->
+ gen_server:call(ServerRef,{verbosity,all,Verbosity});
+verbosity(ServerRef,manager,Verbosity) ->
+ gen_server:call(ServerRef,{verbosity,manager,Verbosity});
+verbosity(ServerRef,request,Verbosity) ->
+ gen_server:call(ServerRef,{verbosity,request,Verbosity});
+verbosity(ServerRef,acceptor,Verbosity) ->
+ gen_server:call(ServerRef,{verbosity,acceptor,Verbosity});
+verbosity(ServerRef,security,Verbosity) ->
+ gen_server:call(ServerRef,{verbosity,security,Verbosity});
+verbosity(ServerRef,auth,Verbosity) ->
+ gen_server:call(ServerRef,{verbosity,auth,Verbosity}).
+
+%%
+%% Internal API
+%%
+
+
+%% new_connection
+
+new_connection(Manager) ->
+ gen_server:call(Manager, {new_connection, self()}).
+
+%% done
+
+done_connection(Manager) ->
+ gen_server:cast(Manager, {done_connection, self()}).
+
+
+%% is_busy(ServerRef) -> true | false
+%%
+%% Tests if the server is (in usage state) busy,
+%% i.e. has rached the heavy load limit.
+%%
+
+is_busy(ServerRef) ->
+ gen_server:call(ServerRef,is_busy).
+
+is_busy(ServerRef,Timeout) ->
+ gen_server:call(ServerRef,is_busy,Timeout).
+
+
+%% is_busy_or_blocked(ServerRef) -> busy | blocked | false
+%%
+%% Tests if the server is busy (usage state), i.e. has rached,
+%% the heavy load limit, or blocked (admin state) .
+%%
+
+is_busy_or_blocked(ServerRef) ->
+ gen_server:call(ServerRef,is_busy_or_blocked).
+
+
+%% is_blocked(ServerRef) -> true | false
+%%
+%% Tests if the server is blocked (admin state) .
+%%
+
+is_blocked(ServerRef) ->
+ gen_server:call(ServerRef,is_blocked).
+
+
+%%
+%% Module API. Theese functions are intended for use from modules only.
+%%
+
+config_lookup(Port, Query) ->
+ config_lookup(undefined, Port, Query).
+config_lookup(Addr, Port, Query) ->
+ Name = httpd_util:make_name("httpd",Addr,Port),
+ gen_server:call(whereis(Name), {config_lookup, Query}).
+
+config_multi_lookup(Port, Query) ->
+ config_multi_lookup(undefined,Port,Query).
+config_multi_lookup(Addr,Port, Query) ->
+ Name = httpd_util:make_name("httpd",Addr,Port),
+ gen_server:call(whereis(Name), {config_multi_lookup, Query}).
+
+config_match(Port, Pattern) ->
+ config_match(undefined,Port,Pattern).
+config_match(Addr, Port, Pattern) ->
+ Name = httpd_util:make_name("httpd",Addr,Port),
+ gen_server:call(whereis(Name), {config_match, Pattern}).
+
+
+%%
+%% Server call-back functions
+%%
+
+%% init
+
+init([ConfigFile, ConfigList, Addr, Port, Verbosity]) ->
+ process_flag(trap_exit, true),
+ case (catch do_init(ConfigFile, ConfigList, Addr, Port, Verbosity)) of
+ {error, Reason} ->
+ ?vlog("failed starting server: ~p", [Reason]),
+ {stop, Reason};
+ {ok, State} ->
+ {ok, State}
+ end.
+
+
+do_init(ConfigFile, ConfigList, Addr, Port, Verbosity) ->
+ put(sname,man),
+ set_verbosity(Verbosity),
+ ?vlog("starting",[]),
+ ConfigDB = do_initial_store(ConfigList),
+ ?vtrace("config db: ~p", [ConfigDB]),
+ SocketType = httpd_socket:config(ConfigDB),
+ ?vtrace("socket type: ~p, now start acceptor", [SocketType]),
+ case httpd_acceptor_sup:start_acceptor(SocketType, Addr, Port, ConfigDB) of
+ {ok, Pid} ->
+ ?vtrace("acceptor started: ~p", [Pid]),
+ Status = [{max_conn,0}, {last_heavy_load,never},
+ {last_connection,never}],
+ State = #state{socket_type = SocketType,
+ config_file = ConfigFile,
+ config_db = ConfigDB,
+ connections = [],
+ status = Status},
+ ?vdebug("started",[]),
+ {ok, State};
+ Else ->
+ Else
+ end.
+
+
+do_initial_store(ConfigList) ->
+ case httpd_conf:store(ConfigList) of
+ {ok, ConfigDB} ->
+ ConfigDB;
+ {error, Reason} ->
+ ?vinfo("failed storing configuration: ~p",[Reason]),
+ throw({error, Reason})
+ end.
+
+
+
+%% handle_call
+
+handle_call(stop, _From, State) ->
+ ?vlog("stop",[]),
+ {stop, normal, ok, State};
+
+handle_call({config_lookup, Query}, _From, State) ->
+ ?vlog("config lookup: Query = ~p",[Query]),
+ Res = httpd_util:lookup(State#state.config_db, Query),
+ ?vdebug("config lookup result: ~p",[Res]),
+ {reply, Res, State};
+
+handle_call({config_multi_lookup, Query}, _From, State) ->
+ ?vlog("multi config lookup: Query = ~p",[Query]),
+ Res = httpd_util:multi_lookup(State#state.config_db, Query),
+ ?vdebug("multi config lookup result: ~p",[Res]),
+ {reply, Res, State};
+
+handle_call({config_match, Query}, _From, State) ->
+ ?vlog("config match: Query = ~p",[Query]),
+ Res = ets:match_object(State#state.config_db, Query),
+ ?vdebug("config match result: ~p",[Res]),
+ {reply, Res, State};
+
+handle_call(get_status, _From, State) ->
+ ?vdebug("get status",[]),
+ ManagerStatus = manager_status(self()),
+ %% AuthStatus = auth_status(get(auth_server)),
+ %% SecStatus = sec_status(get(sec_server)),
+ %% AccStatus = sec_status(get(acceptor_server)),
+ S1 = [{current_conn,length(State#state.connections)}|State#state.status]++
+ [ManagerStatus],
+ ?vtrace("status = ~p",[S1]),
+ {reply,S1,State};
+
+handle_call(is_busy, From, State) ->
+ Reply = case get_ustate(State) of
+ busy ->
+ true;
+ _ ->
+ false
+ end,
+ ?vlog("is busy: ~p",[Reply]),
+ {reply,Reply,State};
+
+handle_call(is_busy_or_blocked, From, State) ->
+ Reply =
+ case get_astate(State) of
+ unblocked ->
+ case get_ustate(State) of
+ busy ->
+ busy;
+ _ ->
+ false
+ end;
+ _ ->
+ blocked
+ end,
+ ?vlog("is busy or blocked: ~p",[Reply]),
+ {reply,Reply,State};
+
+handle_call(is_blocked, From, State) ->
+ Reply =
+ case get_astate(State) of
+ unblocked ->
+ false;
+ _ ->
+ true
+ end,
+ ?vlog("is blocked: ~p",[Reply]),
+ {reply,Reply,State};
+
+handle_call(get_admin_state, From, State) ->
+ Reply = get_astate(State),
+ ?vlog("admin state: ~p",[Reply]),
+ {reply,Reply,State};
+
+handle_call(get_usage_state, From, State) ->
+ Reply = get_ustate(State),
+ ?vlog("usage state: ~p",[Reply]),
+ {reply,Reply,State};
+
+handle_call({verbosity,Who,Verbosity}, From, State) ->
+ V = ?vvalidate(Verbosity),
+ ?vlog("~n Set new verbosity to ~p for ~p",[V,Who]),
+ Reply = set_verbosity(Who,V,State),
+ {reply,Reply,State};
+
+handle_call(restart, From, State) when State#state.admin_state == blocked ->
+ ?vlog("restart",[]),
+ case handle_restart(State) of
+ {stop, Reply,S1} ->
+ {stop, Reply, S1};
+ {_, Reply, S1} ->
+ {reply,Reply,S1}
+ end;
+
+handle_call(restart, From, State) ->
+ ?vlog("restart(~p)",[State#state.admin_state]),
+ {reply,{error,{invalid_admin_state,State#state.admin_state}},State};
+
+handle_call(block, From, State) ->
+ ?vlog("block(disturbing)",[]),
+ {Reply,S1} = handle_block(State),
+ {reply,Reply,S1};
+
+handle_call(unblock, {From,_Tag}, State) ->
+ ?vlog("unblock",[]),
+ {Reply,S1} = handle_unblock(State,From),
+ {reply, Reply, S1};
+
+handle_call({new_connection, Pid}, From, State) ->
+ ?vlog("~n New connection (~p) when connection count = ~p",
+ [Pid,length(State#state.connections)]),
+ {S, S1} = handle_new_connection(State, Pid),
+ Reply = {S, get(request_handler_verbosity)},
+ {reply, Reply, S1};
+
+handle_call(Request, From, State) ->
+ ?vinfo("~n unknown request '~p' from ~p", [Request,From]),
+ String =
+ lists:flatten(
+ io_lib:format("Unknown request "
+ "~n ~p"
+ "~nto manager (~p)"
+ "~nfrom ~p",
+ [Request, self(), From])),
+ report_error(State,String),
+ {reply, ok, State}.
+
+
+%% handle_cast
+
+handle_cast({done_connection, Pid}, State) ->
+ ?vlog("~n Done connection (~p)", [Pid]),
+ S1 = handle_done_connection(State, Pid),
+ {noreply, S1};
+
+handle_cast({block, disturbing, Timeout, From, Ref}, State) ->
+ ?vlog("block(disturbing,~p)",[Timeout]),
+ S1 = handle_block(State, Timeout, From, Ref),
+ {noreply,S1};
+
+handle_cast({block, non_disturbing, Timeout, From, Ref}, State) ->
+ ?vlog("block(non-disturbing,~p)",[Timeout]),
+ S1 = handle_nd_block(State, Timeout, From, Ref),
+ {noreply,S1};
+
+handle_cast(Message, State) ->
+ ?vinfo("~n received unknown message '~p'",[Message]),
+ String =
+ lists:flatten(
+ io_lib:format("Unknown message "
+ "~n ~p"
+ "~nto manager (~p)",
+ [Message, self()])),
+ report_error(State, String),
+ {noreply, State}.
+
+%% handle_info
+
+handle_info({block_timeout, Method}, State) ->
+ ?vlog("received block_timeout event",[]),
+ S1 = handle_block_timeout(State,Method),
+ {noreply, S1};
+
+handle_info({'DOWN', Ref, process, _Object, Info}, State) ->
+ ?vlog("~n down message for ~p",[Ref]),
+ S1 =
+ case State#state.blocker_ref of
+ Ref ->
+ handle_blocker_exit(State);
+ _ ->
+ %% Not our blocker, so ignore
+ State
+ end,
+ {noreply, S1};
+
+handle_info({'EXIT', Pid, normal}, State) ->
+ ?vdebug("~n Normal exit message from ~p", [Pid]),
+ {noreply, State};
+
+handle_info({'EXIT', Pid, blocked}, S) ->
+ ?vdebug("blocked exit signal from request handler (~p)", [Pid]),
+ {noreply, S};
+
+handle_info({'EXIT', Pid, Reason}, State) ->
+ ?vlog("~n Exit message from ~p for reason ~p",[Pid, Reason]),
+ S1 = check_connections(State, Pid, Reason),
+ {noreply, S1};
+
+handle_info(Info, State) ->
+ ?vinfo("~n received unknown info '~p'",[Info]),
+ String =
+ lists:flatten(
+ io_lib:format("Unknown info "
+ "~n ~p"
+ "~nto manager (~p)",
+ [Info, self()])),
+ report_error(State, String),
+ {noreply, State}.
+
+
+%% terminate
+
+terminate(R, #state{config_db = Db}) ->
+ ?vlog("Terminating for reason: ~n ~p", [R]),
+ httpd_conf:remove_all(Db),
+ ok.
+
+
+%% code_change({down,ToVsn}, State, Extra)
+%%
+%% NOTE:
+%% Actually upgrade from 2.5.1 to 2.5.3 and downgrade from
+%% 2.5.3 to 2.5.1 is done with an application restart, so
+%% these function is actually never used. The reason for keeping
+%% this stuff is only for future use.
+%%
+code_change({down,ToVsn},State,Extra) ->
+ {ok,State};
+
+%% code_change(FromVsn, State, Extra)
+%%
+code_change(FromVsn,State,Extra) ->
+ {ok,State}.
+
+
+
+%% -------------------------------------------------------------------------
+%% check_connection
+%%
+%%
+%%
+%%
+
+check_connections(#state{connections = []} = State, _Pid, _Reason) ->
+ State;
+check_connections(#state{admin_state = shutting_down,
+ connections = Connections} = State, Pid, Reason) ->
+ %% Could be a crashing request handler
+ case lists:delete(Pid, Connections) of
+ [] -> % Crashing request handler => block complete
+ String =
+ lists:flatten(
+ io_lib:format("request handler (~p) crashed:"
+ "~n ~p", [Pid, Reason])),
+ report_error(State, String),
+ ?vlog("block complete",[]),
+ demonitor_blocker(State#state.blocker_ref),
+ {Tmr,From,Ref} = State#state.blocking_tmr,
+ ?vlog("(possibly) stop block timer",[]),
+ stop_block_tmr(Tmr),
+ ?vlog("and send the reply",[]),
+ From ! {block_reply,ok,Ref},
+ State#state{admin_state = blocked, connections = [],
+ blocker_ref = undefined};
+ Connections1 ->
+ State#state{connections = Connections1}
+ end;
+check_connections(#state{connections = Connections} = State, Pid, Reason) ->
+ case lists:delete(Pid, Connections) of
+ Connections -> % Not a request handler, so ignore
+ State;
+ Connections1 ->
+ String =
+ lists:flatten(
+ io_lib:format("request handler (~p) crashed:"
+ "~n ~p", [Pid, Reason])),
+ report_error(State, String),
+ State#state{connections = lists:delete(Pid, Connections)}
+ end.
+
+
+%% -------------------------------------------------------------------------
+%% handle_[new | done]_connection
+%%
+%%
+%%
+%%
+
+handle_new_connection(State, Handler) ->
+ UsageState = get_ustate(State),
+ AdminState = get_astate(State),
+ handle_new_connection(UsageState, AdminState, State, Handler).
+
+handle_new_connection(busy, unblocked, State, Handler) ->
+ Status = update_heavy_load_status(State#state.status),
+ {{reject, busy},
+ State#state{status = Status}};
+
+handle_new_connection(_UsageState, unblocked, State, Handler) ->
+ Connections = State#state.connections,
+ Status = update_connection_status(State#state.status,
+ length(Connections)+1),
+ link(Handler),
+ {accept,
+ State#state{connections = [Handler|Connections], status = Status}};
+
+handle_new_connection(_UsageState, _AdminState, State, _Handler) ->
+ {{reject, blocked},
+ State}.
+
+
+handle_done_connection(#state{admin_state = shutting_down,
+ connections = Connections} = State, Handler) ->
+ unlink(Handler),
+ case lists:delete(Handler, Connections) of
+ [] -> % Ok, block complete
+ ?vlog("block complete",[]),
+ demonitor_blocker(State#state.blocker_ref),
+ {Tmr,From,Ref} = State#state.blocking_tmr,
+ ?vlog("(possibly) stop block timer",[]),
+ stop_block_tmr(Tmr),
+ ?vlog("and send the reply",[]),
+ From ! {block_reply,ok,Ref},
+ State#state{admin_state = blocked, connections = [],
+ blocker_ref = undefined};
+ Connections1 ->
+ State#state{connections = Connections1}
+ end;
+
+handle_done_connection(#state{connections = Connections} = State, Handler) ->
+ State#state{connections = lists:delete(Handler, Connections)}.
+
+
+%% -------------------------------------------------------------------------
+%% handle_block
+%%
+%%
+%%
+%%
+handle_block(#state{admin_state = AdminState} = S) ->
+ handle_block(S, AdminState).
+
+handle_block(S,unblocked) ->
+ %% Kill all connections
+ ?vtrace("handle_block(unblocked) -> kill all request handlers",[]),
+%% [exit(Pid,blocked) || Pid <- S#state.connections],
+ [kill_handler(Pid) || Pid <- S#state.connections],
+ {ok,S#state{connections = [], admin_state = blocked}};
+handle_block(S,blocked) ->
+ ?vtrace("handle_block(blocked) -> already blocked",[]),
+ {ok,S};
+handle_block(S,shutting_down) ->
+ ?vtrace("handle_block(shutting_down) -> ongoing...",[]),
+ {{error,shutting_down},S}.
+
+
+kill_handler(Pid) ->
+ ?vtrace("kill request handler: ~p",[Pid]),
+ exit(Pid, blocked).
+%% exit(Pid, kill).
+
+handle_block(S,Timeout,From,Ref) when Timeout >= 0 ->
+ do_block(S,Timeout,From,Ref);
+
+handle_block(S,Timeout,From,Ref) ->
+ Reply = {error,{invalid_block_request,Timeout}},
+ From ! {block_reply,Reply,Ref},
+ S.
+
+do_block(S,Timeout,From,Ref) ->
+ case S#state.connections of
+ [] ->
+ %% Already in idle usage state => go directly to blocked
+ ?vdebug("do_block -> already in idle usage state",[]),
+ From ! {block_reply,ok,Ref},
+ S#state{admin_state = blocked};
+ _ ->
+ %% Active or Busy usage state => go to shutting_down
+ ?vdebug("do_block -> active or busy usage state",[]),
+ %% Make sure we get to know if blocker dies...
+ ?vtrace("do_block -> create blocker monitor",[]),
+ MonitorRef = monitor_blocker(From),
+ ?vtrace("do_block -> (possibly) start block timer",[]),
+ Tmr = {start_block_tmr(Timeout,disturbing),From,Ref},
+ S#state{admin_state = shutting_down,
+ blocker_ref = MonitorRef, blocking_tmr = Tmr}
+ end.
+
+handle_nd_block(S,infinity,From,Ref) ->
+ do_nd_block(S,infinity,From,Ref);
+
+handle_nd_block(S,Timeout,From,Ref) when Timeout >= 0 ->
+ do_nd_block(S,Timeout,From,Ref);
+
+handle_nd_block(S,Timeout,From,Ref) ->
+ Reply = {error,{invalid_block_request,Timeout}},
+ From ! {block_reply,Reply,Ref},
+ S.
+
+do_nd_block(S,Timeout,From,Ref) ->
+ case S#state.connections of
+ [] ->
+ %% Already in idle usage state => go directly to blocked
+ ?vdebug("do_nd_block -> already in idle usage state",[]),
+ From ! {block_reply,ok,Ref},
+ S#state{admin_state = blocked};
+ _ ->
+ %% Active or Busy usage state => go to shutting_down
+ ?vdebug("do_nd_block -> active or busy usage state",[]),
+ %% Make sure we get to know if blocker dies...
+ ?vtrace("do_nd_block -> create blocker monitor",[]),
+ MonitorRef = monitor_blocker(From),
+ ?vtrace("do_nd_block -> (possibly) start block timer",[]),
+ Tmr = {start_block_tmr(Timeout,non_disturbing),From,Ref},
+ S#state{admin_state = shutting_down,
+ blocker_ref = MonitorRef, blocking_tmr = Tmr}
+ end.
+
+handle_block_timeout(S,Method) ->
+ %% Time to take this to the road...
+ demonitor_blocker(S#state.blocker_ref),
+ handle_block_timeout1(S,Method,S#state.blocking_tmr).
+
+handle_block_timeout1(S,non_disturbing,{_,From,Ref}) ->
+ ?vdebug("handle_block_timeout1(non-disturbing) -> send reply: timeout",[]),
+ From ! {block_reply,{error,timeout},Ref},
+ S#state{admin_state = unblocked,
+ blocker_ref = undefined, blocking_tmr = undefined};
+
+handle_block_timeout1(S,disturbing,{_,From,Ref}) ->
+ ?vdebug("handle_block_timeout1(disturbing) -> kill all connections",[]),
+ [exit(Pid,blocked) || Pid <- S#state.connections],
+
+ ?vdebug("handle_block_timeout1 -> send reply: ok",[]),
+ From ! {block_reply,ok,Ref},
+ S#state{admin_state = blocked, connections = [],
+ blocker_ref = undefined, blocking_tmr = undefined};
+
+handle_block_timeout1(S,Method,{_,From,Ref}) ->
+ ?vinfo("received block timeout with unknown block method:"
+ "~n Method: ~p",[Method]),
+ From ! {block_reply,{error,{unknown_block_method,Method}},Ref},
+ S#state{admin_state = blocked, connections = [],
+ blocker_ref = undefined, blocking_tmr = undefined};
+
+handle_block_timeout1(S,Method,TmrInfo) ->
+ ?vinfo("received block timeout with erroneous timer info:"
+ "~n Method: ~p"
+ "~n TmrInfo: ~p",[Method,TmrInfo]),
+ S#state{admin_state = unblocked,
+ blocker_ref = undefined, blocking_tmr = undefined}.
+
+handle_unblock(S,FromA) ->
+ handle_unblock(S,FromA,S#state.admin_state).
+
+handle_unblock(S,_FromA,unblocked) ->
+ {ok,S};
+handle_unblock(S,FromA,_AdminState) ->
+ ?vtrace("handle_unblock -> (possibly) stop block timer",[]),
+ stop_block_tmr(S#state.blocking_tmr),
+ case S#state.blocking_tmr of
+ {Tmr,FromB,Ref} ->
+ %% Another process is trying to unblock
+ %% Inform the blocker
+ FromB ! {block_reply, {error,{unblocked,FromA}},Ref};
+ _ ->
+ ok
+ end,
+ {ok,S#state{admin_state = unblocked, blocking_tmr = undefined}}.
+
+%% The blocker died so we give up on the block.
+handle_blocker_exit(S) ->
+ {Tmr,_From,_Ref} = S#state.blocking_tmr,
+ ?vtrace("handle_blocker_exit -> (possibly) stop block timer",[]),
+ stop_block_tmr(Tmr),
+ S#state{admin_state = unblocked,
+ blocker_ref = undefined, blocking_tmr = undefined}.
+
+
+
+%% -------------------------------------------------------------------------
+%% handle_restart
+%%
+%%
+%%
+%%
+handle_restart(#state{config_file = undefined} = State) ->
+ {continue, {error, undefined_config_file}, State};
+handle_restart(#state{config_db = Db, config_file = ConfigFile} = State) ->
+ ?vtrace("load new configuration",[]),
+ {ok, Config} = httpd_conf:load(ConfigFile),
+ ?vtrace("check for illegal changes (addr, port and socket-type)",[]),
+ case (catch check_constant_values(Db, Config)) of
+ ok ->
+ %% If something goes wrong between the remove
+ %% and the store where fu-ed
+ ?vtrace("remove old configuration, now hold you breath...",[]),
+ httpd_conf:remove_all(Db),
+ ?vtrace("store new configuration",[]),
+ case httpd_conf:store(Config) of
+ {ok, NewConfigDB} ->
+ ?vlog("restart done, puh!",[]),
+ {continue, ok, State#state{config_db = NewConfigDB}};
+ Error ->
+ ?vlog("failed store new config: ~n ~p",[Error]),
+ {stop, Error, State}
+ end;
+ Error ->
+ ?vlog("restart NOT performed due to:"
+ "~n ~p",[Error]),
+ {continue, Error, State}
+ end.
+
+
+check_constant_values(Db, Config) ->
+ %% Check port number
+ ?vtrace("check_constant_values -> check port number",[]),
+ Port = httpd_util:lookup(Db,port),
+ case httpd_util:key1search(Config,port) of %% MUST be equal
+ Port ->
+ ok;
+ OtherPort ->
+ throw({error,{port_number_changed,Port,OtherPort}})
+ end,
+
+ %% Check bind address
+ ?vtrace("check_constant_values -> check bind address",[]),
+ Addr = httpd_util:lookup(Db,bind_address),
+ case httpd_util:key1search(Config,bind_address) of %% MUST be equal
+ Addr ->
+ ok;
+ OtherAddr ->
+ throw({error,{addr_changed,Addr,OtherAddr}})
+ end,
+
+ %% Check socket type
+ ?vtrace("check_constant_values -> check socket type",[]),
+ SockType = httpd_util:lookup(Db, com_type),
+ case httpd_util:key1search(Config, com_type) of %% MUST be equal
+ SockType ->
+ ok;
+ OtherSockType ->
+ throw({error,{sock_type_changed,SockType,OtherSockType}})
+ end,
+ ?vtrace("check_constant_values -> done",[]),
+ ok.
+
+
+%% get_ustate(State) -> idle | active | busy
+%%
+%% Retrieve the usage state of the HTTP server:
+%% 0 active connection -> idle
+%% max_clients active connections -> busy
+%% Otherwise -> active
+%%
+get_ustate(State) ->
+ get_ustate(length(State#state.connections),State).
+
+get_ustate(0,_State) ->
+ idle;
+get_ustate(ConnectionCnt,State) ->
+ ConfigDB = State#state.config_db,
+ case httpd_util:lookup(ConfigDB, max_clients, 150) of
+ ConnectionCnt ->
+ busy;
+ _ ->
+ active
+ end.
+
+
+get_astate(S) -> S#state.admin_state.
+
+
+%% Timer handling functions
+start_block_tmr(infinity,_) ->
+ undefined;
+start_block_tmr(T,M) ->
+ erlang:send_after(T,self(),{block_timeout,M}).
+
+stop_block_tmr(undefined) ->
+ ok;
+stop_block_tmr(Ref) ->
+ erlang:cancel_timer(Ref).
+
+
+%% Monitor blocker functions
+monitor_blocker(Pid) when pid(Pid) ->
+ case (catch erlang:monitor(process,Pid)) of
+ MonitorRef ->
+ MonitorRef;
+ {'EXIT',Reason} ->
+ undefined
+ end;
+monitor_blocker(_) ->
+ undefined.
+
+demonitor_blocker(undefined) ->
+ ok;
+demonitor_blocker(Ref) ->
+ (catch erlang:demonitor(Ref)).
+
+
+%% Some status utility functions
+
+update_heavy_load_status(Status) ->
+ update_status_with_time(Status,last_heavy_load).
+
+update_connection_status(Status,ConnCount) ->
+ S1 = case lists:keysearch(max_conn,1,Status) of
+ {value,{max_conn,C1}} when ConnCount > C1 ->
+ lists:keyreplace(max_conn,1,Status,{max_conn,ConnCount});
+ {value,{max_conn,C2}} ->
+ Status;
+ false ->
+ [{max_conn,ConnCount}|Status]
+ end,
+ update_status_with_time(S1,last_connection).
+
+update_status_with_time(Status,Key) ->
+ lists:keyreplace(Key,1,Status,{Key,universal_time()}).
+
+universal_time() -> calendar:universal_time().
+
+
+auth_status(P) when pid(P) ->
+ Items = [status, message_queue_len, reductions,
+ heap_size, stack_size, current_function],
+ {auth_status, process_status(P,Items,[])};
+auth_status(_) ->
+ {auth_status, undefined}.
+
+sec_status(P) when pid(P) ->
+ Items = [status, message_queue_len, reductions,
+ heap_size, stack_size, current_function],
+ {security_status, process_status(P,Items,[])};
+sec_status(_) ->
+ {security_status, undefined}.
+
+acceptor_status(P) when pid(P) ->
+ Items = [status, message_queue_len, reductions,
+ heap_size, stack_size, current_function],
+ {acceptor_status, process_status(P,Items,[])};
+acceptor_status(_) ->
+ {acceptor_status, undefined}.
+
+
+manager_status(P) ->
+ Items = [status, message_queue_len, reductions,
+ heap_size, stack_size],
+ {manager_status, process_status(P,Items,[])}.
+
+
+process_status(P,[],L) ->
+ [{pid,P}|lists:reverse(L)];
+process_status(P,[H|T],L) ->
+ case (catch process_info(P,H)) of
+ {H, Value} ->
+ process_status(P,T,[{H,Value}|L]);
+ _ ->
+ process_status(P,T,[{H,undefined}|L])
+ end.
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd",Addr,Port).
+
+
+report_error(State,String) ->
+ Cdb = State#state.config_db,
+ error_logger:error_report(String),
+ mod_log:report_error(Cdb,String),
+ mod_disk_log:report_error(Cdb,String).
+
+
+set_verbosity(V) ->
+ Units = [manager_verbosity,
+ acceptor_verbosity, request_handler_verbosity,
+ security_verbosity, auth_verbosity],
+ case httpd_util:key1search(V, all) of
+ undefined ->
+ set_verbosity(V, Units);
+ Verbosity when atom(Verbosity) ->
+ V1 = [{Unit, Verbosity} || Unit <- Units],
+ set_verbosity(V1, Units)
+ end.
+
+set_verbosity(_V, []) ->
+ ok;
+set_verbosity(V, [manager_verbosity = Unit|Units]) ->
+ Verbosity = httpd_util:key1search(V, Unit, ?default_verbosity),
+ put(verbosity, ?vvalidate(Verbosity)),
+ set_verbosity(V, Units);
+set_verbosity(V, [Unit|Units]) ->
+ Verbosity = httpd_util:key1search(V, Unit, ?default_verbosity),
+ put(Unit, ?vvalidate(Verbosity)),
+ set_verbosity(V, Units).
+
+
+set_verbosity(manager,V,_S) ->
+ put(verbosity,V);
+set_verbosity(acceptor,V,_S) ->
+ put(acceptor_verbosity,V);
+set_verbosity(request,V,_S) ->
+ put(request_handler_verbosity,V);
+set_verbosity(security,V,S) ->
+ OldVerbosity = put(security_verbosity,V),
+ Addr = httpd_util:lookup(S#state.config_db, bind_address),
+ Port = httpd_util:lookup(S#state.config_db, port),
+ mod_security_server:verbosity(Addr,Port,V),
+ OldVerbosity;
+set_verbosity(auth,V,S) ->
+ OldVerbosity = put(auth_verbosity,V),
+ Addr = httpd_util:lookup(S#state.config_db, bind_address),
+ Port = httpd_util:lookup(S#state.config_db, port),
+ mod_auth_server:verbosity(Addr,Port,V),
+ OldVerbosity;
+
+set_verbosity(all,V,S) ->
+ OldMv = put(verbosity,V),
+ OldAv = put(acceptor_verbosity,V),
+ OldRv = put(request_handler_verbosity,V),
+ OldSv = put(security_verbosity,V),
+ OldAv = put(auth_verbosity,V),
+ Addr = httpd_util:lookup(S#state.config_db, bind_address),
+ Port = httpd_util:lookup(S#state.config_db, port),
+ mod_security_server:verbosity(Addr,Port,V),
+ mod_auth_server:verbosity(Addr,Port,V),
+ [{manager,OldMv}, {request,OldRv}, {security,OldSv}, {auth, OldAv}].
+
+
+%%
+call(ServerRef,Request) ->
+ gen_server:call(ServerRef,Request).
+
+cast(ServerRef,Message) ->
+ gen_server:cast(ServerRef,Message).
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_misc_sup.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_misc_sup.erl
new file mode 100644
index 0000000000..5921c5db60
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_misc_sup.erl
@@ -0,0 +1,116 @@
+%% ``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: httpd_misc_sup.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for the Megaco/H.248 application
+%%----------------------------------------------------------------------
+
+-module(httpd_misc_sup).
+
+-behaviour(supervisor).
+
+-include("httpd_verbosity.hrl").
+
+%% public
+-export([start/3, stop/1, init/1]).
+
+-export([start_auth_server/3, stop_auth_server/2,
+ start_sec_server/3, stop_sec_server/2]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% supervisor callback functions
+
+
+start(Addr, Port, MiscSupVerbosity) ->
+ SupName = make_name(Addr, Port),
+ supervisor:start_link({local, SupName}, ?MODULE, [MiscSupVerbosity]).
+
+stop(StartArgs) ->
+ ok.
+
+init([Verbosity]) -> % Supervisor
+ do_init(Verbosity);
+init(BadArg) ->
+ {error, {badarg, BadArg}}.
+
+do_init(Verbosity) ->
+ put(verbosity,?vvalidate(Verbosity)),
+ put(sname,misc_sup),
+ ?vlog("starting", []),
+ Flags = {one_for_one, 0, 1},
+ KillAfter = timer:seconds(1),
+ Workers = [],
+ {ok, {Flags, Workers}}.
+
+
+%%----------------------------------------------------------------------
+%% Function: [start|stop]_[auth|sec]_server/3
+%% Description: Starts a [auth | security] worker (child) process
+%%----------------------------------------------------------------------
+
+start_auth_server(Addr, Port, Verbosity) ->
+ start_permanent_worker(mod_auth_server, Addr, Port,
+ Verbosity, [gen_server]).
+
+stop_auth_server(Addr, Port) ->
+ stop_permanent_worker(mod_auth_server, Addr, Port).
+
+
+start_sec_server(Addr, Port, Verbosity) ->
+ start_permanent_worker(mod_security_server, Addr, Port,
+ Verbosity, [gen_server]).
+
+stop_sec_server(Addr, Port) ->
+ stop_permanent_worker(mod_security_server, Addr, Port).
+
+
+
+%%----------------------------------------------------------------------
+%% Function: start_permanent_worker/5
+%% Description: Starts a permanent worker (child) process
+%%----------------------------------------------------------------------
+
+start_permanent_worker(Mod, Addr, Port, Verbosity, Modules) ->
+ SupName = make_name(Addr, Port),
+ Spec = {{Mod, Addr, Port},
+ {Mod, start_link, [Addr, Port, Verbosity]},
+ permanent, timer:seconds(1), worker, [Mod] ++ Modules},
+ supervisor:start_child(SupName, Spec).
+
+
+%%----------------------------------------------------------------------
+%% Function: stop_permanent_worker/3
+%% Description: Stops a permanent worker (child) process
+%%----------------------------------------------------------------------
+
+stop_permanent_worker(Mod, Addr, Port) ->
+ SupName = make_name(Addr, Port),
+ Name = {Mod, Addr, Port},
+ case supervisor:terminate_child(SupName, Name) of
+ ok ->
+ supervisor:delete_child(SupName, Name);
+ Error ->
+ Error
+ end.
+
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd_misc_sup",Addr,Port).
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_parse.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_parse.erl
new file mode 100644
index 0000000000..3f8f0837f9
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_parse.erl
@@ -0,0 +1,348 @@
+%% ``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: httpd_parse.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(httpd_parse).
+-export([
+ request_header/1,
+ hsplit/2,
+ get_request_record/10,
+ split_lines/1,
+ tagup_header/1]).
+-include("httpd.hrl").
+
+
+%%----------------------------------------------------------------------
+%% request_header
+%%
+%% Input: The request as sent from the client (list of characters)
+%% (may include part of the entity body)
+%%
+%% Returns:
+%% {ok, Info#mod}
+%% {not_implemented,Info#mod}
+%% {bad_request, Reason}
+%%----------------------------------------------------------------------
+
+request_header(Header)->
+ [RequestLine|HeaderFields] = split_lines(Header),
+ ?DEBUG("request ->"
+ "~n RequestLine: ~p"
+ "~n Header: ~p",[RequestLine,Header]),
+ ParsedHeader = tagup_header(HeaderFields),
+ ?DEBUG("request ->"
+ "~n ParseHeader: ~p",[ParsedHeader]),
+ case verify_request(string:tokens(RequestLine," ")) of
+ ["HEAD", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
+ {ok, ["HEAD", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
+ ParsedHeader]};
+ ["GET", RequestURI, "HTTP/0.9"] ->
+ {ok, ["GET", RequestURI, "HTTP/0.9", RequestLine, ParsedHeader]};
+ ["GET", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
+ {ok, ["GET", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
+ ParsedHeader]};
+ ["POST", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
+ {ok, ["POST", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
+ ParsedHeader]};
+ %%HTTP must be 1.1 or higher
+ ["TRACE", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] when N>48->
+ {ok, ["TRACE", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
+ ParsedHeader]};
+ [Method, RequestURI] ->
+ {not_implemented, RequestLine, Method, RequestURI,ParsedHeader,"HTTP/0.9"};
+ [Method, RequestURI, HTTPVersion] ->
+ {not_implemented, RequestLine, Method, RequestURI,ParsedHeader, HTTPVersion};
+ {bad_request, Reason} ->
+ {bad_request, Reason};
+ Reason ->
+ {bad_request, "Unknown request method"}
+ end.
+
+
+
+
+
+
+%%----------------------------------------------------------------------
+%% The request is passed through the server as a record of type mod get it
+%% ----------------------------------------------------------------------
+
+get_request_record(Socket,SocketType,ConfigDB,Method,RequestURI,
+ HTTPVersion,RequestLine,ParsedHeader,EntityBody,InitData)->
+ PersistentConn=get_persistens(HTTPVersion,ParsedHeader,ConfigDB),
+ Info=#mod{init_data=InitData,
+ data=[],
+ socket_type=SocketType,
+ socket=Socket,
+ config_db=ConfigDB,
+ method=Method,
+ absolute_uri=formatAbsoluteURI(RequestURI,ParsedHeader),
+ request_uri=formatRequestUri(RequestURI),
+ http_version=HTTPVersion,
+ request_line=RequestLine,
+ parsed_header=ParsedHeader,
+ entity_body=maybe_remove_nl(ParsedHeader,EntityBody),
+ connection=PersistentConn},
+ {ok,Info}.
+
+%%----------------------------------------------------------------------
+%% Conmtrol wheater we shall maintain a persistent connection or not
+%%----------------------------------------------------------------------
+get_persistens(HTTPVersion,ParsedHeader,ConfigDB)->
+ case httpd_util:lookup(ConfigDB,persistent_conn,true) of
+ true->
+ case HTTPVersion of
+ %%If it is version prio to 1.1 kill the conneciton
+ [$H, $T, $T, $P, $\/, $1, $.,N] ->
+ case httpd_util:key1search(ParsedHeader,"connection","keep-alive")of
+ %%if the connection isnt ordered to go down let it live
+ %%The keep-alive value is the older http/1.1 might be older
+ %%Clients that use it.
+ "keep-alive" when N >= 49 ->
+ ?DEBUG("CONNECTION MODE: ~p",[true]),
+ true;
+ "close" ->
+ ?DEBUG("CONNECTION MODE: ~p",[false]),
+ false;
+ Connect ->
+ ?DEBUG("CONNECTION MODE: ~p VALUE: ~p",[false,Connect]),
+ false
+ end;
+ _ ->
+ ?DEBUG("CONNECTION MODE: ~p VERSION: ~p",[false,HTTPVersion]),
+ false
+
+ end;
+ _ ->
+ false
+ end.
+
+
+
+
+%%----------------------------------------------------------------------
+%% Control whether the last newline of the body is a part of the message or
+%%it is a part of the multipart message.
+%%----------------------------------------------------------------------
+maybe_remove_nl(Header,Rest) ->
+ case find_content_type(Header) of
+ false ->
+ {ok,EntityBody,_}=regexp:sub(Rest,"\r\n\$",""),
+ EntityBody;
+ {ok, Value} ->
+ case string:str(Value, "multipart/form-data") of
+ 0 ->
+ {ok,EntityBody,_}=regexp:sub(Rest,"\r\n\$",""),
+ EntityBody;
+ _ ->
+ Rest
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Cet the content type of the incomming request
+%%----------------------------------------------------------------------
+
+
+find_content_type([]) ->
+ false;
+find_content_type([{Name,Value}|Tail]) ->
+ case httpd_util:to_lower(Name) of
+ "content-type" ->
+ {ok, Value};
+ _ ->
+ find_content_type(Tail)
+ end.
+
+%%----------------------------------------------------------------------
+%% Split the header to a list of strings where each string represents a
+%% HTTP header-field
+%%----------------------------------------------------------------------
+split_lines(Request) ->
+ split_lines(Request, [], []).
+split_lines([], CAcc, Acc) ->
+ lists:reverse([lists:reverse(CAcc)|Acc]);
+
+%%White space in the header fields are allowed but the new line must begin with LWS se
+%%rfc2616 chap 4.2. The rfc do not say what to
+split_lines([$\r, $\n, $\t |Rest], CAcc, Acc) ->
+ split_lines(Rest, [$\r, $\n |CAcc], Acc);
+
+split_lines([$\r, $\n, $\s |Rest], CAcc, Acc) ->
+ split_lines(Rest, [$\r, $\n |CAcc], Acc);
+
+split_lines([$\r, $\n|Rest], CAcc, Acc) ->
+ split_lines(Rest, [], [lists:reverse(CAcc)|Acc]);
+split_lines([Chr|Rest], CAcc, Acc) ->
+ split_lines(Rest, [Chr|CAcc], Acc).
+
+
+%%----------------------------------------------------------------------
+%% This is a 'hack' to stop people from trying to access directories/files
+%% relative to the ServerRoot.
+%%----------------------------------------------------------------------
+
+
+verify_request([Request, RequestURI]) ->
+ verify_request([Request, RequestURI, "HTTP/0.9"]);
+
+verify_request([Request, RequestURI, Protocol]) ->
+ NewRequestURI =
+ case string:str(RequestURI, "?") of
+ 0 ->
+ RequestURI;
+ Ndx ->
+ string:left(RequestURI, Ndx)
+ end,
+ case string:str(NewRequestURI, "..") of
+ 0 ->
+ [Request, RequestURI, Protocol];
+ _ ->
+ {bad_request, {forbidden, RequestURI}}
+ end;
+verify_request(Request) ->
+ Request.
+
+%%----------------------------------------------------------------------
+%% tagup_header
+%%
+%% Parses the header of a HTTP request and returns a key,value tuple
+%% list containing Name and Value of each header directive as of:
+%%
+%% Content-Type: multipart/mixed -> {"Content-Type", "multipart/mixed"}
+%%
+%% But in http/1.1 the field-names are case insencitive so now it must be
+%% Content-Type: multipart/mixed -> {"content-type", "multipart/mixed"}
+%% The standard furthermore says that leading and traling white space
+%% is not a part of the fieldvalue and shall therefore be removed.
+%%----------------------------------------------------------------------
+
+tagup_header([]) -> [];
+tagup_header([Line|Rest]) -> [tag(Line, [])|tagup_header(Rest)].
+
+tag([], Tag) ->
+ {httpd_util:to_lower(lists:reverse(Tag)), ""};
+tag([$:|Rest], Tag) ->
+ {httpd_util:to_lower(lists:reverse(Tag)), httpd_util:strip(Rest)};
+tag([Chr|Rest], Tag) ->
+ tag(Rest, [Chr|Tag]).
+
+
+%%----------------------------------------------------------------------
+%% There are 3 possible forms of the reuqest URI
+%%
+%% 1. * When the request is not for a special assset. is is instead
+%% to the server itself
+%%
+%% 2. absoluteURI the whole servername port and asset is in the request
+%%
+%% 3. The most common form that http/1.0 used abs path that is a path
+%% to the requested asset.
+%5----------------------------------------------------------------------
+formatRequestUri("*")->
+ "*";
+formatRequestUri([$h,$t,$t,$p,$:,$\/,$\/|ServerAndPath]) ->
+ removeServer(ServerAndPath);
+
+formatRequestUri([$H,$T,$T,$P,$:,$\/,$\/|ServerAndPath]) ->
+ removeServer(ServerAndPath);
+
+formatRequestUri(ABSPath) ->
+ ABSPath.
+
+removeServer([$\/|Url])->
+ case Url of
+ []->
+ "/";
+ _->
+ [$\/|Url]
+ end;
+removeServer([N|Url]) ->
+ removeServer(Url).
+
+
+formatAbsoluteURI([$h,$t,$t,$p,$:,$\/,$\/|Uri],ParsedHeader)->
+ [$H,$T,$T,$P,$:,$\/,$\/|Uri];
+
+formatAbsoluteURI([$H,$T,$T,$P,$:,$\/,$\/|Uri],ParsedHeader)->
+ [$H,$T,$T,$P,$:,$\/,$\/|Uri];
+
+formatAbsoluteURI(Uri,ParsedHeader)->
+ case httpd_util:key1search(ParsedHeader,"host") of
+ undefined ->
+ nohost;
+ Host ->
+ Host++Uri
+ end.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%Code below is crap from an older version shall be removed when
+%%transformation to http/1.1 is finished
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+%request(Request) ->
+% ?DEBUG("request -> entry with:"
+% "~n Request: ~s",[Request]),
+ % {BeforeEntityBody, Rest} = hsplit([], Request),
+ % ?DEBUG("request ->"
+% "~n BeforeEntityBody: ~p"
+% "~n Rest: ~p",[BeforeEntityBody, Rest]),
+% [RequestLine|Header] = split_lines(BeforeEntityBody),
+% ?DEBUG("request ->"
+% "~n RequestLine: ~p"
+% "~n Header: ~p",[RequestLine,Header]),
+% ParsedHeader = tagup_header(Header),
+% ?DEBUG("request ->"
+% "~n ParseHeader: ~p",[ParsedHeader]),
+% EntityBody = maybe_remove_nl(ParsedHeader,Rest),
+% ?DEBUG("request ->"
+% "~n EntityBody: ~p",[EntityBody]),
+% case verify_request(string:tokens(RequestLine," ")) of
+% ["HEAD", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
+% {ok, ["HEAD", formatRequestUri(RequestURI), [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
+% ParsedHeader, EntityBody]};
+% ["GET", RequestURI, "HTTP/0.9"] ->
+% {ok, ["GET", RequestURI, "HTTP/0.9", RequestLine, ParsedHeader,
+% EntityBody]};
+% ["GET", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
+% {ok, ["GET", formatRequestUri(RequestURI), [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
+% ParsedHeader,EntityBody]};
+%% ["POST", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
+% {ok, ["POST", formatRequestUri(RequestURI), [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
+% ParsedHeader, EntityBody]};
+% [Method, RequestURI] ->
+% {not_implemented, RequestLine, Method, RequestURI,ParsedHeader,"HTTP/0.9"};
+% [Method, RequestURI, HTTPVersion] ->
+% {not_implemented, RequestLine, Method, RequestURI,ParsedHeader, HTTPVersion};
+% {bad_request, Reason} ->
+% {bad_request, Reason};
+% Reason ->
+% {bad_request, "Unknown request method"}
+% end.
+
+hsplit(Accu,[]) ->
+ {lists:reverse(Accu), []};
+hsplit(Accu, [ $\r, $\n, $\r, $\n | Tail]) ->
+ {lists:reverse(Accu), Tail};
+hsplit(Accu, [H|T]) ->
+ hsplit([H|Accu],T).
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_request_handler.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_request_handler.erl
new file mode 100644
index 0000000000..5008e6022e
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_request_handler.erl
@@ -0,0 +1,995 @@
+%% ``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: httpd_request_handler.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(httpd_request_handler).
+
+%% app internal api
+-export([start_link/2, synchronize/3]).
+
+%% module internal api
+-export([connection/2, do_next_connection/6, read_header/7]).
+-export([parse_trailers/1, newline/1]).
+
+-include("httpd.hrl").
+-include("httpd_verbosity.hrl").
+
+
+%% start_link
+
+start_link(Manager, ConfigDB) ->
+ Pid = proc_lib:spawn(?MODULE, connection, [Manager, ConfigDB]),
+ {ok, Pid}.
+
+
+%% synchronize
+
+synchronize(Pid, SocketType, Socket) ->
+ Pid ! {synchronize, SocketType, Socket}.
+
+% connection
+
+connection(Manager, ConfigDB) ->
+ {SocketType, Socket, {Status, Verbosity}} = await_synchronize(Manager),
+ put(sname,self()),
+ put(verbosity,?vvalidate(Verbosity)),
+ connection1(Status, Manager, ConfigDB, SocketType, Socket).
+
+
+connection1({reject, busy}, Manager, ConfigDB, SocketType, Socket) ->
+ handle_busy(Manager, ConfigDB, SocketType, Socket);
+
+connection1({reject, blocked}, Manager, ConfigDB, SocketType, Socket) ->
+ handle_blocked(Manager, ConfigDB, SocketType, Socket);
+
+connection1(accept, Manager, ConfigDB, SocketType, Socket) ->
+ handle_connection(Manager, ConfigDB, SocketType, Socket).
+
+
+%% await_synchronize
+
+await_synchronize(Manager) ->
+ receive
+ {synchronize, SocketType, Socket} ->
+ ?vlog("received syncronize: "
+ "~n SocketType: ~p"
+ "~n Socket: ~p", [SocketType, Socket]),
+ {SocketType, Socket, httpd_manager:new_connection(Manager)}
+ after 5000 ->
+ exit(synchronize_timeout)
+ end.
+
+
+% handle_busy
+
+handle_busy(Manager, ConfigDB, SocketType, Socket) ->
+ ?vlog("handle busy: ~p", [Socket]),
+ MaxClients = httpd_util:lookup(ConfigDB, max_clients, 150),
+ String = io_lib:format("heavy load (>~w processes)", [MaxClients]),
+ reject_connection(Manager, ConfigDB, SocketType, Socket, String).
+
+
+% handle_blocked
+
+handle_blocked(Manager, ConfigDB, SocketType, Socket) ->
+ ?vlog("handle blocked: ~p", [Socket]),
+ String = "Server maintenance performed, try again later",
+ reject_connection(Manager, ConfigDB, SocketType, Socket, String).
+
+
+% reject_connection
+
+reject_connection(Manager, ConfigDB, SocketType, Socket, Info) ->
+ String = lists:flatten(Info),
+ ?vtrace("send status (503) message", []),
+ httpd_response:send_status(SocketType, Socket, 503, String, ConfigDB),
+ %% This ugly thing is to make ssl deliver the message, before the close...
+ close_sleep(SocketType, 1000),
+ ?vtrace("close the socket", []),
+ close(SocketType, Socket, ConfigDB).
+
+
+% handle_connection
+
+handle_connection(Manager, ConfigDB, SocketType, Socket) ->
+ ?vlog("handle connection: ~p", [Socket]),
+ Resolve = httpd_socket:resolve(SocketType),
+ Peername = httpd_socket:peername(SocketType, Socket),
+ InitData = #init_data{peername=Peername, resolve=Resolve},
+ TimeOut = httpd_util:lookup(ConfigDB, keep_alive_timeout, 150000),
+ NrOfRequest = httpd_util:lookup(ConfigDB, max_keep_alive_request, forever),
+ ?MODULE:do_next_connection(ConfigDB, InitData,
+ SocketType, Socket,NrOfRequest,TimeOut),
+ ?vlog("handle connection: done", []),
+ httpd_manager:done_connection(Manager),
+ ?vlog("handle connection: close socket", []),
+ close(SocketType, Socket, ConfigDB).
+
+
+% do_next_connection
+do_next_connection(_ConfigDB, _InitData, _SocketType, _Socket, NrOfRequests,
+ _Timeout) when NrOfRequests < 1 ->
+ ?vtrace("do_next_connection: done", []),
+ ok;
+do_next_connection(ConfigDB, InitData, SocketType, Socket, NrOfRequests,
+ Timeout) ->
+ Peername = InitData#init_data.peername,
+ case (catch read(ConfigDB, SocketType, Socket, InitData, Timeout)) of
+ {'EXIT', Reason} ->
+ ?vlog("exit reading from socket: ~p",[Reason]),
+ error_logger:error_report({'EXIT',Reason}),
+ String =
+ lists:flatten(
+ io_lib:format("exit reading from socket: ~p => ~n~p~n",
+ [Socket, Reason])),
+ error_log(mod_log,
+ SocketType, Socket, ConfigDB, Peername, String),
+ error_log(mod_disk_log,
+ SocketType, Socket, ConfigDB, Peername, String);
+ {error, Reason} ->
+ handle_read_error(Reason,SocketType,Socket,ConfigDB,Peername);
+ Info when record(Info, mod) ->
+ case Info#mod.connection of
+ true ->
+ ReqTimeout = httpd_util:lookup(ConfigDB,
+ keep_alive_timeout, 150000),
+ ?MODULE:do_next_connection(ConfigDB, InitData,
+ SocketType, Socket,
+ dec(NrOfRequests), ReqTimeout);
+ _ ->
+ ok
+ end;
+ _ ->
+ ok
+ end.
+
+
+
+%% read
+read(ConfigDB, SocketType, Socket, InitData, Timeout) ->
+ ?vdebug("read from socket ~p with Timeout ~p",[Socket, Timeout]),
+ MaxHdrSz = httpd_util:lookup(ConfigDB, max_header_size, 10240),
+ case ?MODULE:read_header(SocketType, Socket, Timeout, MaxHdrSz,
+ ConfigDB, InitData, []) of
+ {socket_closed, Reason} ->
+ ?vlog("Socket closed while reading request header: "
+ "~n ~p", [Reason]),
+ socket_close;
+ {error, Error} ->
+ {error, Error};
+ {ok, Info, EntityBodyPart} ->
+ read1(SocketType, Socket, ConfigDB, InitData, Timeout, Info,
+ EntityBodyPart)
+ end.
+
+%% Got the head and maybe a part of the body: read in the rest
+read1(SocketType, Socket, ConfigDB, InitData, Timeout, Info, BodyPart)->
+ MaxBodySz = httpd_util:lookup(ConfigDB, max_body_size, nolimit),
+ ContentLength = content_length(Info),
+ ?vtrace("ContentLength: ~p", [ContentLength]),
+ case read_entity_body(SocketType, Socket, Timeout, MaxBodySz,
+ ContentLength, BodyPart, Info, ConfigDB) of
+ {socket_closed, Reason} ->
+ ?vlog("Socket closed while reading request body: "
+ "~n ~p", [Reason]),
+ socket_close;
+ {ok, EntityBody} ->
+ finish_request(EntityBody, [], Info);
+ {ok, ExtraHeader, EntityBody} ->
+ finish_request(EntityBody, ExtraHeader, Info);
+ Response ->
+ httpd_socket:close(SocketType, Socket),
+ socket_closed
+ %% Catch up all bad return values
+ end.
+
+
+%% The request is read in send it forward to the module that
+%% generates the response
+
+finish_request(EntityBody, ExtraHeader,
+ #mod{parsed_header = ParsedHeader} = Info)->
+ ?DEBUG("finish_request -> ~n"
+ " EntityBody: ~p~n"
+ " ExtraHeader: ~p~n"
+ " ParsedHeader: ~p~n",
+ [EntityBody, ExtraHeader, ParsedHeader]),
+ httpd_response:send(Info#mod{parsed_header = ParsedHeader ++ ExtraHeader,
+ entity_body = EntityBody}).
+
+
+%% read_header
+
+%% This algorithm rely on the buffer size of the inet driver together
+%% with the {active, once} socket option. Atmost one message of this
+%% size will be received at a given time. When a full header has been
+%% read, the body is read with the recv function (the body size is known).
+%%
+read_header(SocketType, Socket, Timeout, MaxHdrSz, ConfigDB,
+ InitData, SoFar0) ->
+ T = t(),
+ %% remove any newlines at the begining, they might be crap from ?
+ SoFar = remove_newline(SoFar0),
+
+ case terminated_header(MaxHdrSz, SoFar) of
+ {true, Header, EntityBodyPart} ->
+ ?vdebug("read_header -> done reading header: "
+ "~n length(Header): ~p"
+ "~n length(EntityBodyPart): ~p",
+ [length(Header), length(EntityBodyPart)]),
+ transform_header(SocketType, Socket, Header, ConfigDB, InitData,
+ EntityBodyPart);
+ false ->
+ ?vtrace("read_header -> "
+ "~n set active = 'once' and "
+ "await a chunk of the header", []),
+
+ case httpd_socket:active_once(SocketType, Socket) of
+ ok ->
+ receive
+ %%
+ %% TCP
+ %%
+ {tcp, Socket, Data} ->
+ ?vtrace("read_header(ip) -> got some data: ~p",
+ [sz(Data)]),
+ ?MODULE:read_header(SocketType, Socket,
+ Timeout - (t()-T),
+ MaxHdrSz, ConfigDB,
+ InitData, SoFar ++ Data);
+ {tcp_closed, Socket} ->
+ ?vtrace("read_header(ip) -> socket closed",[]),
+ {socket_closed,normal};
+ {tcp_error, Socket, Reason} ->
+ ?vtrace("read_header(ip) -> socket error: ~p",
+ [Reason]),
+ {socket_closed, Reason};
+
+ %%
+ %% SSL
+ %%
+ {ssl, Socket, Data} ->
+ ?vtrace("read_header(ssl) -> got some data: ~p",
+ [sz(Data)]),
+ ?MODULE:read_header(SocketType, Socket,
+ Timeout - (t()-T),
+ MaxHdrSz, ConfigDB,
+ InitData, SoFar ++ Data);
+ {ssl_closed, Socket} ->
+ ?vtrace("read_header(ssl) -> socket closed", []),
+ {socket_closed, normal};
+ {ssl_error, Socket, Reason} ->
+ ?vtrace("read_header(ssl) -> socket error: ~p",
+ [Reason]),
+ {socket_closed, Reason}
+
+ after Timeout ->
+ ?vlog("read_header -> timeout", []),
+ {socket_closed, timeout}
+ end;
+
+ Error ->
+ httpd_response:send_status(SocketType, Socket,
+ 500, none, ConfigDB),
+ Error
+ end
+ end.
+
+
+terminated_header(MaxHdrSz, Data) ->
+ D1 = lists:flatten(Data),
+ ?vtrace("terminated_header -> Data size: ~p",[sz(D1)]),
+ case hsplit(MaxHdrSz,[],D1) of
+ not_terminated ->
+ false;
+ [Header, EntityBodyPart] ->
+ {true, Header++"\r\n\r\n",EntityBodyPart}
+ end.
+
+
+transform_header(SocketType, Socket, Request, ConfigDB, InitData, BodyPart) ->
+ case httpd_parse:request_header(Request) of
+ {not_implemented, RequestLine, Method, RequestURI, ParsedHeader,
+ HTTPVersion} ->
+ httpd_response:send_status(SocketType, Socket, 501,
+ {Method, RequestURI, HTTPVersion},
+ ConfigDB),
+ {error,"Not Implemented"};
+ {bad_request, {forbidden, URI}} ->
+ httpd_response:send_status(SocketType, Socket, 403, URI, ConfigDB),
+ {error,"Forbidden Request"};
+ {bad_request, Reason} ->
+ httpd_response:send_status(SocketType, Socket, 400, none,
+ ConfigDB),
+ {error,"Malformed request"};
+ {ok,[Method, RequestURI, HTTPVersion, RequestLine, ParsedHeader]} ->
+ ?DEBUG("send -> ~n"
+ " Method: ~p~n"
+ " RequestURI: ~p~n"
+ " HTTPVersion: ~p~n"
+ " RequestLine: ~p~n",
+ [Method, RequestURI, HTTPVersion, RequestLine]),
+ {ok, Info} =
+ httpd_parse:get_request_record(Socket, SocketType, ConfigDB,
+ Method, RequestURI, HTTPVersion,
+ RequestLine, ParsedHeader,
+ [], InitData),
+ %% Control that the Host header field is provided
+ case Info#mod.absolute_uri of
+ nohost ->
+ case Info#mod.http_version of
+ "HTTP/1.1" ->
+ httpd_response:send_status(Info, 400, none),
+ {error,"No host specified"};
+ _ ->
+ {ok, Info, BodyPart}
+ end;
+ _ ->
+ {ok, Info, BodyPart}
+ end
+ end.
+
+
+hsplit(_MaxHdrSz, Accu,[]) ->
+ not_terminated;
+hsplit(_MaxHdrSz, Accu, [ $\r, $\n, $\r, $\n | Tail]) ->
+ [lists:reverse(Accu), Tail];
+hsplit(nolimit, Accu, [H|T]) ->
+ hsplit(nolimit,[H|Accu],T);
+hsplit(MaxHdrSz, Accu, [H|T]) when length(Accu) < MaxHdrSz ->
+ hsplit(MaxHdrSz,[H|Accu],T);
+hsplit(MaxHdrSz, Accu, D) ->
+ throw({error,{header_too_long,length(Accu),length(D)}}).
+
+
+
+%%----------------------------------------------------------------------
+%% The http/1.1 standard chapter 8.2.3 says that a request containing
+%% An Except header-field must be responded to by 100 (Continue) by
+%% the server before the client sends the body.
+%%----------------------------------------------------------------------
+
+read_entity_body(SocketType, Socket, Timeout, Max, Length, BodyPart, Info,
+ ConfigDB) when integer(Max) ->
+ case expect(Info#mod.http_version, Info#mod.parsed_header, ConfigDB) of
+ continue when Max > Length ->
+ ?DEBUG("read_entity_body()->100 Continue ~n", []),
+ httpd_response:send_status(Info, 100, ""),
+ read_entity_body2(SocketType, Socket, Timeout, Max, Length,
+ BodyPart, Info, ConfigDB);
+ continue when Max < Length ->
+ httpd_response:send_status(Info, 417, "Body to big"),
+ httpd_socket:close(SocketType, Socket),
+ {socket_closed,"Expect denied according to size"};
+ break ->
+ httpd_response:send_status(Info, 417, "Method not allowed"),
+ httpd_socket:close(SocketType, Socket),
+ {socket_closed,"Expect conditions was not fullfilled"};
+ no_expect_header ->
+ read_entity_body2(SocketType, Socket, Timeout, Max, Length,
+ BodyPart, Info, ConfigDB);
+ http_1_0_expect_header ->
+ httpd_response:send_status(Info, 400,
+ "Only HTTP/1.1 Clients "
+ "may use the Expect Header"),
+ httpd_socket:close(SocketType, Socket),
+ {socket_closed,"Due to a HTTP/1.0 expect header"}
+ end;
+
+read_entity_body(SocketType, Socket, Timeout, Max, Length, BodyPart,
+ Info, ConfigDB) ->
+ case expect(Info#mod.http_version, Info#mod.parsed_header, ConfigDB) of
+ continue ->
+ ?DEBUG("read_entity_body() -> 100 Continue ~n", []),
+ httpd_response:send_status(Info, 100, ""),
+ read_entity_body2(SocketType, Socket, Timeout, Max, Length,
+ BodyPart, Info, ConfigDB);
+ break->
+ httpd_response:send_status(Info, 417, "Method not allowed"),
+ httpd_socket:close(SocketType, Socket),
+ {socket_closed,"Expect conditions was not fullfilled"};
+ no_expect_header ->
+ read_entity_body2(SocketType, Socket, Timeout, Max, Length,
+ BodyPart, Info, ConfigDB);
+ http_1_0_expect_header ->
+ httpd_response:send_status(Info, 400,
+ "HTTP/1.0 Clients are not allowed "
+ "to use the Expect Header"),
+ httpd_socket:close(SocketType, Socket),
+ {socket_closed,"Expect header field in an HTTP/1.0 request"}
+ end.
+
+%%----------------------------------------------------------------------
+%% control if the body is transfer encoded
+%%----------------------------------------------------------------------
+read_entity_body2(SocketType, Socket, Timeout, Max, Length, BodyPart,
+ Info, ConfigDB) ->
+ ?DEBUG("read_entity_body2() -> "
+ "~n Max: ~p"
+ "~n Length: ~p"
+ "~n Socket: ~p", [Max, Length, Socket]),
+
+ case transfer_coding(Info) of
+ {chunked, ChunkedData} ->
+ ?DEBUG("read_entity_body2() -> "
+ "Transfer-encoding: Chunked Data: BodyPart ~s", [BodyPart]),
+ read_chunked_entity(Info, Timeout, Max, Length, ChunkedData, [],
+ BodyPart);
+ unknown_coding ->
+ ?DEBUG("read_entity_body2() -> Transfer-encoding: Unknown",[]),
+ httpd_response:send_status(Info, 501, "Unknown Transfer-Encoding"),
+ httpd_socket:close(SocketType, Socket),
+ {socket_closed,"Expect conditions was not fullfilled"};
+ none ->
+ ?DEBUG("read_entity_body2() -> Transfer-encoding: none",[]),
+ read_entity_body(SocketType, Socket, Timeout, Max, Length,
+ BodyPart)
+ end.
+
+
+%%----------------------------------------------------------------------
+%% The body was plain read it from the socket
+%% ----------------------------------------------------------------------
+read_entity_body(_SocketType, _Socket, _Timeout, _Max, 0, _BodyPart) ->
+ {ok, []};
+
+read_entity_body(_SocketType, _Socket, _Timeout, Max, Len, _BodyPart)
+ when Max < Len ->
+ ?vlog("body to long: "
+ "~n Max: ~p"
+ "~n Len: ~p", [Max,Len]),
+ throw({error,{body_too_long,Max,Len}});
+
+%% OTP-4409: Fixing POST problem
+read_entity_body(_,_,_,_, Len, BodyPart) when Len == length(BodyPart) ->
+ ?vtrace("read_entity_body -> done when"
+ "~n Len = length(BodyPart): ~p", [Len]),
+ {ok, BodyPart};
+
+%% OTP-4550: Fix problem with trailing garbage produced by some clients.
+read_entity_body(_, _, _, _, Len, BodyPart) when Len < length(BodyPart) ->
+ ?vtrace("read_entity_body -> done when"
+ "~n Len: ~p"
+ "~n length(BodyPart): ~p", [Len, length(BodyPart)]),
+ {ok, lists:sublist(BodyPart,Len)};
+
+read_entity_body(SocketType, Socket, Timeout, Max, Len, BodyPart) ->
+ ?vtrace("read_entity_body -> entry when"
+ "~n Len: ~p"
+ "~n length(BodyPart): ~p", [Len, length(BodyPart)]),
+ %% OTP-4548:
+ %% The length calculation was previously (inets-2.*) done in the
+ %% read function. As of 3.0 it was removed from read but not
+ %% included here.
+ L = Len - length(BodyPart),
+ case httpd_socket:recv(SocketType, Socket, L, Timeout) of
+ {ok, Body} ->
+ ?vtrace("read_entity_body -> received some data:"
+ "~n length(Body): ~p", [length(Body)]),
+ {ok, BodyPart ++ Body};
+ {error,closed} ->
+ {socket_closed,normal};
+ {error,etimedout} ->
+ {socket_closed, timeout};
+ {error,Reason} ->
+ {socket_closed, Reason};
+ Other ->
+ {socket_closed, Other}
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% If the body of the message is encoded used the chunked transfer encoding
+%% it looks somethin like this:
+%% METHOD URI HTTP/VSN
+%% Transfer-Encoding: chunked
+%% CRLF
+%% ChunkSize
+%% Chunk
+%% ChunkSize
+%% Chunk
+%% 0
+%% Trailer
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+read_chunked_entity(Info, Timeout, Max, Length, ChunkedData, Body, []) ->
+ ?DEBUG("read_chunked_entity()->:no_chunks ~n", []),
+ read_chunked_entity(Info#mod.socket_type, Info#mod.socket,
+ Timeout, Max, Length, ChunkedData, Body,
+ Info#mod.config_db, Info);
+
+read_chunked_entity(Info, Timeout, Max, Length, ChunkedData, Body, BodyPart) ->
+ %% Get the size
+ ?DEBUG("read_chunked_entity() -> PrefetchedBodyPart: ~p ~n",[BodyPart]),
+ case parse_chunk_size(Info, Timeout, BodyPart) of
+ {ok, Size, NewBodyPart} when Size > 0 ->
+ ?DEBUG("read_chunked_entity() -> Size: ~p ~n", [Size]),
+ case parse_chunked_entity_body(Info, Timeout, Max, length(Body),
+ Size, NewBodyPart) of
+ {ok, Chunk, NewBodyPart1} ->
+ ?DEBUG("read_chunked_entity()->Size: ~p ~n", [Size]),
+ read_chunked_entity(Info, Timeout, Max, Length,
+ ChunkedData, Body ++ Chunk,
+ NewBodyPart1);
+ OK ->
+ httpd_socket:close(Info#mod.socket_type, Info#mod.socket),
+ {socket_closed, error}
+ end;
+ {ok, 0, Trailers} ->
+ ?DEBUG("read_chunked_entity()->Size: 0, Trailers: ~s Body: ~s ~n",
+ [Trailers, Body]),
+ case parse_chunk_trailer(Info, Timeout, Info#mod.config_db,
+ Trailers) of
+ {ok, TrailerFields} ->
+ {ok, TrailerFields, Body};
+ _->
+ {ok, []}
+ end;
+ Error ->
+ Error
+ end.
+
+
+parse_chunk_size(Info, Timeout, BodyPart) ->
+ case httpd_util:split(remove_newline(BodyPart), "\r\n", 2) of
+ {ok, [Size, Body]} ->
+ ?DEBUG("parse_chunk_size()->Size: ~p ~n", [Size]),
+ {ok, httpd_util:hexlist_to_integer(Size), Body};
+ {ok, [Size]} ->
+ ?DEBUG("parse_chunk_size()->Size: ~p ~n", [Size]),
+ Sz = get_chunk_size(Info#mod.socket_type,
+ Info#mod.socket, Timeout,
+ lists:reverse(Size)),
+ {ok, Sz, []}
+ end.
+
+%%----------------------------------------------------------------------
+%% We got the chunk size get the chunk
+%%
+%% Max: Max numbers of bytes to read may also be undefined
+%% Length: Numbers of bytes already read
+%% Size Numbers of byte to read for the chunk
+%%----------------------------------------------------------------------
+
+%% body to big
+parse_chunked_entity_body(Info, Timeout, Max, Length, Size, BodyPart)
+ when Max =< (Length + Size) ->
+ {error, body_to_big};
+
+%% Prefetched body part is bigger than the current chunk
+%% (i.e. BodyPart includes more than one chunk)
+parse_chunked_entity_body(Info, Timeout, Max, Length, Size, BodyPart)
+ when (Size+2) =< length(BodyPart) ->
+ Chunk = string:substr(BodyPart, 1, Size),
+ Rest = string:substr(BodyPart, Size+3),
+ ?DEBUG("parse_chunked_entity_body() -> ~nChunk: ~s ~nRest: ~s ~n",
+ [Chunk, Rest]),
+ {ok, Chunk, Rest};
+
+
+%% We just got a part of the current chunk
+parse_chunked_entity_body(Info, Timeout, Max, Length, Size, BodyPart) ->
+ %% OTP-4551:
+ %% Subtracting BodyPart from Size does not produce an integer
+ %% when BodyPart is a list...
+ Remaining = Size - length(BodyPart),
+ LastPartOfChunk = read_chunked_entity_body(Info#mod.socket_type,
+ Info#mod.socket,
+ Timeout, Max,
+ Length, Remaining),
+ %% Remove newline
+ httpd_socket:recv(Info#mod.socket_type, Info#mod.socket, 2, Timeout),
+ ?DEBUG("parse_chunked_entity_body() -> "
+ "~nBodyPart: ~s"
+ "~nLastPartOfChunk: ~s ~n",
+ [BodyPart, LastPartOfChunk]),
+ {ok, BodyPart ++ LastPartOfChunk, []}.
+
+
+%%----------------------------------------------------------------------
+%% If the data we got along with the header contained the whole chunked body
+%% It may aswell contain the trailer :-(
+%%----------------------------------------------------------------------
+%% Either trailer begins with \r\n and then all data is there or
+%% The trailer has data then read upto \r\n\r\n
+parse_chunk_trailer(Info,Timeout,ConfigDB,"\r\n")->
+ {ok,[]};
+parse_chunk_trailer(Info,Timeout,ConfigDB,Trailers) ->
+ ?DEBUG("parse_chunk_trailer()->Trailers: ~s ~n", [Trailers]),
+ case string:rstr(Trailers,"\r\n\r\n") of
+ 0 ->
+ MaxHdrSz=httpd_util:lookup(ConfigDB, max_header_size, 10240),
+ read_trailer_end(Info,Timeout,MaxHdrSz,Trailers);
+ _->
+ %%We got the whole header parse it up
+ parse_trailers(Trailers)
+ end.
+
+parse_trailers(Trailer)->
+ ?DEBUG("parse_trailer()->Trailer: ~s",[Trailer]),
+ {ok,[Fields0|Crap]}=httpd_util:split(Trailer,"\r\n\r\n",2),
+ Fields=string:tokens(Fields0,"\r\n"),
+ [getTrailerField(X)||X<-Fields,lists:member($:,X)].
+
+
+read_trailer_end(Info,Timeout,MaxHdrSz,[])->
+ ?DEBUG("read_trailer_end()->[]",[]),
+ case read_trailer(Info#mod.socket_type,Info#mod.socket,
+ Timeout,MaxHdrSz,[],[],
+ httpd_util:key1search(Info#mod.parsed_header,"trailer",[])) of
+ {ok,Trailers}->
+ Trailers;
+ _->
+ []
+ end;
+read_trailer_end(Info,Timeout,MaxHdrSz,Trailers)->
+ ?DEBUG("read_trailer_end()->Trailers: ~s ~n ",[Trailers]),
+ %% Get the last paart of the the last headerfield
+ End=lists:reverse(lists:takewhile(fun(X)->case X of 10 ->false;13->false;_ ->true end end,lists:reverse(Trailers))),
+ Fields0=regexp:split(Trailers,"\r\n"),
+ %%Get rid of the last header field
+ [_Last|Fields]=lists:reverse(Fields0),
+ Headers=[getTrailerField(X)||X<-Fields,lists:member($:,X)],
+ case read_trailer(Info#mod.socket_type,Info#mod.socket,
+ Timeout,MaxHdrSz,Headers,End,
+ httpd_util:key1search(Info#mod.parsed_header,"trailer",[])) of
+ {ok,Trailers}->
+ Trailers;
+ _->
+ []
+ end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The code below is a a good way to read in chunked encoding but
+%% that require that the encoding comes from a stream and not from a list
+%%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
+
+%%----------------------------------------------------------------------
+%% The body is encoded by chubnked encoding read it in
+%% ChunkedData= Chunked extensions
+%% Body= the inread chunked body
+%% Max: Max numbers of bytes to read
+%% Length: Numbers of bytes already readed
+%% Size Numbers of byte to read for the chunk
+%%----------------------------------------------------------------------
+
+
+
+read_chunked_entity(SocketType, Socket, Timeout, Max, Length, ChunkedData,
+ Body, ConfigDB, Info) ->
+ T = t(),
+ case get_chunk_size(SocketType,Socket,Timeout,[]) of
+ Size when integer(Size), Size>0 ->
+ case read_chunked_entity_body(SocketType, Socket,
+ Timeout-(t()-T),
+ Max, length(Body), Size) of
+ {ok,Chunk} ->
+ ?DEBUG("read_chunked_entity/9 Got a chunk: ~p " ,[Chunk]),
+ %% Two bytes are left of the chunk, that is the CRLF
+ %% at the end that is not a part of the message
+ %% So we read it and do nothing with it.
+ httpd_socket:recv(SocketType,Socket,2,Timeout-(t()-T)),
+ read_chunked_entity(SocketType, Socket, Timeout-(t()-T),
+ Max, Length, ChunkedData, Body++Chunk,
+ ConfigDB, Info);
+ Error ->
+ ?DEBUG("read_chunked_entity/9 Error: ~p " ,[Error]),
+ httpd_socket:close(SocketType,Socket),
+ {socket_closed,error}
+ end;
+ Size when integer(Size), Size == 0 ->
+ %% Must read in any trailer fields here
+ read_chunk_trailer(SocketType, Socket, Timeout,
+ Max, Info, ChunkedData, Body, ConfigDB);
+ Error ->
+ Error
+ end.
+
+
+%% If a user wants to send header data after the chunked data we
+%% must pick it out
+read_chunk_trailer(SocketType, Socket, Timeout, Max, Info, ChunkedData,
+ Body, ConfigDB) ->
+ ?DEBUG("read_chunk_trailer/8: ~p " ,[Body]),
+ MaxHdrSz = httpd_util:lookup(ConfigDB,max_header_size,10240),
+ case httpd_util:key1search(Info#mod.parsed_header,"trailer")of
+ undefined ->
+ {ok,Body};
+ Fields ->
+ case read_trailer(SocketType, Socket, Timeout,
+ MaxHdrSz, [], [],
+ string:tokens(
+ httpd_util:to_lower(Fields),",")) of
+ {ok,[]} ->
+ {ok,Body};
+ {ok,HeaderFields} ->
+ % ParsedExtraHeaders =
+ % httpd_parse:tagup_header(httpd_parse:split_lines(HeaderFields)),
+ {ok,HeaderFields,Body};
+ Error ->
+ Error
+ end
+ end.
+
+read_chunked_entity_body(SocketType, Socket, Timeout, Max, Length, Size)
+ when integer(Max) ->
+ read_entity_body(SocketType, Socket, Timeout, Max-Length, Size, []);
+
+read_chunked_entity_body(SocketType, Socket, Timeout, Max, _Length, Size) ->
+ read_entity_body(SocketType, Socket, Timeout, Max, Size, []).
+
+%% If we read in the \r\n the httpd_util:hexlist_to_integer
+%% Will remove it and we get rid of it emmediatly :-)
+get_chunk_size(SocketType, Socket, Timeout, Size) ->
+ T = t(),
+ ?DEBUG("get_chunk_size: ~p " ,[Size]),
+ case httpd_socket:recv(SocketType,Socket,1,Timeout) of
+ {ok,[Digit]} when Digit==$\n ->
+ httpd_util:hexlist_to_integer(lists:reverse(Size));
+ {ok,[Digit]} ->
+ get_chunk_size(SocketType,Socket,Timeout-(t()-T),[Digit|Size]);
+ {error,closed} ->
+ {socket_closed,normal};
+ {error,etimedout} ->
+ {socket_closed, timeout};
+ {error,Reason} ->
+ {socket_closed, Reason};
+ Other ->
+ {socket_closed,Other}
+ end.
+
+
+
+
+%%----------------------------------------------------------------------
+%% Reads the HTTP-trailer
+%% Would be easy to tweak the read_head to do this but in this way
+%% the chunked encoding can be updated better.
+%%----------------------------------------------------------------------
+
+
+%% When end is reached
+%% read_trailer(SocketType,Socket,Timeout,MaxHdrSz,Headers,Last,[]) ->
+%% {ok,Headers};
+
+%% When header to big
+read_trailer(_,_,_,MaxHdrSz,Headers,Bs,_Fields)
+ when MaxHdrSz < length(Headers) ->
+ ?vlog("header to long: "
+ "~n MaxHdrSz: ~p"
+ "~n length(Bs): ~p", [MaxHdrSz,length(Bs)]),
+ throw({error,{header_too_long,MaxHdrSz,length(Bs)}});
+
+%% The last Crlf is there
+read_trailer(_, _, _, _, Headers, [$\n, $\r], _) ->
+ {ok,Headers};
+
+read_trailer(SocketType, Socket, Timeout, MaxHdrSz, Headers,
+ [$\n, $\r|Rest], Fields) ->
+ case getTrailerField(lists:reverse(Rest))of
+ {error,Reason}->
+ {error,"Bad trailer"};
+ {HeaderField,Value}->
+ case lists:member(HeaderField,Fields) of
+ true ->
+ read_trailer(SocketType,Socket,Timeout,MaxHdrSz,
+ [{HeaderField,Value} |Headers],[],
+ lists:delete(HeaderField,Fields));
+ false ->
+ read_trailer(SocketType,Socket,Timeout,MaxHdrSz,
+ Headers,[],Fields)
+ end
+ end;
+
+% read_trailer(SocketType,Socket,Timeout,MaxHdrSz,Headers,[$\n, $\r|Rest],Fields) ->
+% case Rest of
+% [] ->
+% read_trailer(SocketType,Socket,Timeout,MaxHdrSz,Headers,Rest,Fields);
+% Field ->
+% case getTrailerField(lists:reverse(Rest))of
+% {error,Reason}->
+% {error,"Bad trailer"};
+% {HeaderField,Value}->
+% case lists:member(HeaderField,Fields) of
+% true ->
+% read_trailer(SocketType,Socket,Timeout,MaxHdrSz,
+% [{HeaderField,Value} |Headers],[],
+% lists:delete(HeaderField,Fields));
+% false ->
+% read_trailer(SocketType,Socket,Timeout,MaxHdrSz,
+% Headers,[],Fields)
+% end
+% end
+% end;
+
+read_trailer(SocketType,Socket,Timeout,MaxHdrSz,Headers,Bs,Fields) ->
+ %% ?vlog("read_header -> entry with Timeout: ~p",[Timeout]),
+ T = t(),
+ case (catch httpd_socket:recv(SocketType,Socket,1,Timeout)) of
+ {ok,[B]} ->
+ read_trailer(SocketType, Socket, Timeout-(t()-T),
+ MaxHdrSz, Headers, [B|Bs], Fields);
+ {error,closed} ->
+ {socket_closed,normal};
+ {error,etimedout} ->
+ {socket_closed, timeout};
+ {error,Reason} ->
+ {socket_closed, Reason};
+ Other ->
+ {socket_closed,Other}
+ end.
+
+getTrailerField(HeaderField)->
+ case string:str(HeaderField,":") of
+ 0->
+ {error,"badheaderfield"};
+ Number ->
+ {httpd_util:to_lower(string:substr(HeaderField,1,Number-1)),
+ httpd_util:to_lower(string:substr(HeaderField,Number+1))}
+ end.
+
+
+
+
+%% Time in milli seconds
+t() ->
+ {A,B,C} = erlang:now(),
+ A*1000000000+B*1000+(C div 1000).
+
+%%----------------------------------------------------------------------
+%% If the user sends an expect header-field with the value 100-continue
+%% We must send a 100 status message if he is a HTTP/1.1 client.
+
+%% If it is an HTTP/1.0 client it's little more difficult.
+%% If expect is not defined it is easy but in the other case shall we
+%% Break or the transmission or let it continue the standard is not clear
+%% if to break connection or wait for data.
+%%----------------------------------------------------------------------
+expect(HTTPVersion,ParsedHeader,ConfigDB)->
+ case HTTPVersion of
+ [$H,$T,$T,$P,$\/,$1,$.,N|_Whatever]when N>=1->
+ case httpd_util:key1search(ParsedHeader,"expect") of
+ "100-continue" ->
+ continue;
+ undefined ->
+ no_expect_header;
+ NewValue ->
+ break
+ end;
+ _OldVersion ->
+ case httpd_util:key1search(ParsedHeader,"expect") of
+ undefined ->
+ no_expect_header;
+ NewValue ->
+ case httpd_util:lookup(ConfigDB,expect,continue) of
+ continue->
+ no_expect_header;
+ _ ->
+ http_1_0_expect_header
+ end
+ end
+ end.
+
+
+%%----------------------------------------------------------------------
+%% According to the http/1.1 standard all applications must understand
+%% Chunked encoded data. (Last line chapter 3.6.1).
+transfer_coding(#mod{parsed_header = Ph}) ->
+ case httpd_util:key1search(Ph, "transfer-encoding", none) of
+ none ->
+ none;
+ [$c,$h,$u,$n,$k,$e,$d|Data]->
+ {chunked,Data};
+ _ ->
+ unknown_coding
+ end.
+
+
+
+handle_read_error({header_too_long,Max,Rem},
+ SocketType,Socket,ConfigDB,Peername) ->
+ String = io_lib:format("header too long: ~p : ~p",[Max,Rem]),
+ handle_read_error(ConfigDB,String,SocketType,Socket,Peername,
+ max_header_action,close);
+handle_read_error({body_too_long,Max,Actual},
+ SocketType,Socket,ConfigDB,Peername) ->
+ String = io_lib:format("body too long: ~p : ~p",[Max,Actual]),
+ handle_read_error(ConfigDB,String,SocketType,Socket,Peername,
+ max_body_action,close);
+handle_read_error(Error,SocketType,Socket,ConfigDB,Peername) ->
+ ok.
+
+
+handle_read_error(ConfigDB, ReasonString, SocketType, Socket, Peername,
+ Item, Default) ->
+ ?vlog("error reading request: ~s",[ReasonString]),
+ E = lists:flatten(
+ io_lib:format("Error reading request: ~s",[ReasonString])),
+ error_log(mod_log, SocketType, Socket, ConfigDB, Peername, E),
+ error_log(mod_disk_log, SocketType, Socket, ConfigDB, Peername, E),
+ case httpd_util:lookup(ConfigDB,Item,Default) of
+ reply414 ->
+ send_read_status(SocketType, Socket, 414, ReasonString, ConfigDB);
+ _ ->
+ ok
+ end.
+
+send_read_status(SocketType, Socket, Code, ReasonString, ConfigDB) ->
+ httpd_response:send_status(SocketType, Socket, Code, ReasonString,
+ ConfigDB).
+
+
+error_log(Mod, SocketType, Socket, ConfigDB, Peername, String) ->
+ Modules = httpd_util:lookup(ConfigDB, modules,
+ [mod_get, mod_head, mod_log]),
+ case lists:member(Mod, Modules) of
+ true ->
+ Mod:error_log(SocketType, Socket, ConfigDB, Peername, String);
+ _ ->
+ ok
+ end.
+
+
+sz(L) when list(L) ->
+ length(L);
+sz(B) when binary(B) ->
+ size(B);
+sz(O) ->
+ {unknown_size,O}.
+
+
+%% Socket utility functions:
+
+close(SocketType, Socket, ConfigDB) ->
+ case httpd_socket:close(SocketType, Socket) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ ?vlog("error while closing socket: ~p",[Reason]),
+ ok
+ end.
+
+close_sleep({ssl, _}, Time) ->
+ sleep(Time);
+close_sleep(_, _) ->
+ ok.
+
+
+sleep(T) -> receive after T -> ok end.
+
+
+dec(N) when integer(N) ->
+ N-1;
+dec(N) ->
+ N.
+
+
+content_length(#mod{parsed_header = Ph}) ->
+ list_to_integer(httpd_util:key1search(Ph, "content-length","0")).
+
+
+remove_newline(List)->
+ lists:dropwhile(fun newline/1,List).
+
+newline($\r) ->
+ true;
+newline($\n) ->
+ true;
+newline(_Sign) ->
+ false.
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_response.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_response.erl
new file mode 100644
index 0000000000..4c7f8e0c8f
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_response.erl
@@ -0,0 +1,437 @@
+%% ``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: httpd_response.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(httpd_response).
+-export([send/1, send_status/3, send_status/5]).
+
+%%code is the key for the statuscode ex: 200 404 ...
+-define(HTTP11HEADERFIELDS,[content_length, accept_ranges, cache_control, date,
+ pragma, trailer, transfer_encoding, etag, location,
+ retry_after, server, allow,
+ content_encoding, content_language,
+ content_location, content_MD5, content_range,
+ content_type, expires, last_modified]).
+
+-define(HTTP10HEADERFIELDS,[content_length, date, pragma, transfer_encoding,
+ location, server, allow, content_encoding,
+ content_type, last_modified]).
+
+-define(PROCEED_RESPONSE(StatusCode, Info),
+ {proceed,
+ [{response,{already_sent, StatusCode,
+ httpd_util:key1search(Info#mod.data,content_lenght)}}]}).
+
+
+-include("httpd.hrl").
+
+-define(VMODULE,"RESPONSE").
+-include("httpd_verbosity.hrl").
+
+%% send
+
+send(#mod{config_db = ConfigDB} = Info) ->
+ ?vtrace("send -> Request line: ~p", [Info#mod.request_line]),
+ Modules = httpd_util:lookup(ConfigDB,modules,[mod_get, mod_head, mod_log]),
+ case traverse_modules(Info, Modules) of
+ done ->
+ Info;
+ {proceed, Data} ->
+ case httpd_util:key1search(Data, status) of
+ {StatusCode, PhraseArgs, Reason} ->
+ ?vdebug("send -> proceed/status: ~n"
+ "~n StatusCode: ~p"
+ "~n PhraseArgs: ~p"
+ "~n Reason: ~p",
+ [StatusCode, PhraseArgs, Reason]),
+ send_status(Info, StatusCode, PhraseArgs),
+ Info;
+
+ undefined ->
+ case httpd_util:key1search(Data, response) of
+ {already_sent, StatusCode, Size} ->
+ ?vtrace("send -> already sent: "
+ "~n StatusCode: ~p"
+ "~n Size: ~p",
+ [StatusCode, Size]),
+ Info;
+ {response, Header, Body} -> %% New way
+ send_response(Info, Header, Body),
+ Info;
+ {StatusCode, Response} -> %% Old way
+ send_response_old(Info, StatusCode, Response),
+ Info;
+ undefined ->
+ ?vtrace("send -> undefined response", []),
+ send_status(Info, 500, none),
+ Info
+ end
+ end
+ end.
+
+
+%% traverse_modules
+
+traverse_modules(Info,[]) ->
+ {proceed,Info#mod.data};
+traverse_modules(Info,[Module|Rest]) ->
+ case (catch apply(Module,do,[Info])) of
+ {'EXIT', Reason} ->
+ ?vlog("traverse_modules -> exit reason: ~p",[Reason]),
+ String =
+ lists:flatten(
+ io_lib:format("traverse exit from apply: ~p:do => ~n~p",
+ [Module, Reason])),
+ report_error(mod_log, Info#mod.config_db, String),
+ report_error(mod_disk_log, Info#mod.config_db, String),
+ done;
+ done ->
+ done;
+ {break,NewData} ->
+ {proceed,NewData};
+ {proceed,NewData} ->
+ traverse_modules(Info#mod{data=NewData},Rest)
+ end.
+
+%% send_status %%
+
+
+send_status(#mod{socket_type = SocketType,
+ socket = Socket,
+ connection = Conn} = Info, 100, _PhraseArgs) ->
+ ?DEBUG("send_status -> StatusCode: ~p~n",[100]),
+ Header = httpd_util:header(100, Conn),
+ httpd_socket:deliver(SocketType, Socket,
+ [Header, "Content-Length:0\r\n\r\n"]);
+
+send_status(#mod{socket_type = SocketType,
+ socket = Socket,
+ config_db = ConfigDB} = Info, StatusCode, PhraseArgs) ->
+ send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB).
+
+send_status(SocketType, Socket, StatusCode, PhraseArgs, ConfigDB) ->
+ ?DEBUG("send_status -> ~n"
+ " StatusCode: ~p~n"
+ " PhraseArgs: ~p",
+ [StatusCode, PhraseArgs]),
+ Header = httpd_util:header(StatusCode, "text/html", false),
+ ReasonPhrase = httpd_util:reason_phrase(StatusCode),
+ Message = httpd_util:message(StatusCode, PhraseArgs, ConfigDB),
+ Body = get_body(ReasonPhrase, Message),
+ Header1 =
+ Header ++
+ "Content-Length:" ++
+ integer_to_list(length(Body)) ++
+ "\r\n\r\n",
+ httpd_socket:deliver(SocketType, Socket, [Header1, Body]).
+
+
+get_body(ReasonPhrase, Message)->
+ "<HTML>
+ <HEAD>
+ <TITLE>"++ReasonPhrase++"</TITLE>
+ </HEAD>
+ <BODY>
+ <H1>"++ReasonPhrase++"</H1>\n"++Message++"\n</BODY>
+ </HTML>\n".
+
+
+%%% Create a response from the Key/Val tuples In the Head List
+%%% Body is a tuple {body,Fun(),Args}
+
+%% send_response
+%% Allowed Fields
+
+% HTTP-Version StatusCode Reason-Phrase
+% *((general-headers
+% response-headers
+% entity-headers)CRLF)
+% CRLF
+% ?(BODY)
+
+% General Header fields
+% ======================
+% Cache-Control cache_control
+% Connection %%Is set dependiong on the request
+% Date
+% Pramga
+% Trailer
+% Transfer-Encoding
+
+% Response Header field
+% =====================
+% Accept-Ranges
+% (Age) Mostly for proxys
+% Etag
+% Location
+% (Proxy-Authenticate) Only for proxies
+% Retry-After
+% Server
+% Vary
+% WWW-Authenticate
+%
+% Entity Header Fields
+% ====================
+% Allow
+% Content-Encoding
+% Content-Language
+% Content-Length
+% Content-Location
+% Content-MD5
+% Content-Range
+% Content-Type
+% Expires
+% Last-Modified
+
+
+send_response(Info, Header, Body) ->
+ ?vtrace("send_response -> (new) entry with"
+ "~n Header: ~p", [Header]),
+ case httpd_util:key1search(Header, code) of
+ undefined ->
+ %% No status code
+ %% Ooops this must be very bad:
+ %% generate a 404 content not availible
+ send_status(Info, 404, "The file is not availible");
+ StatusCode ->
+ case send_header(Info, StatusCode, Header) of
+ ok ->
+ send_body(Info, StatusCode, Body);
+ Error ->
+ ?vlog("head delivery failure: ~p", [Error]),
+ done
+ end
+ end.
+
+
+send_header(#mod{socket_type = Type, socket = Sock,
+ http_version = Ver, connection = Conn} = Info,
+ StatusCode, Head0) ->
+ ?vtrace("send_haeder -> entry with"
+ "~n Ver: ~p"
+ "~n Conn: ~p", [Ver, Conn]),
+ Head1 = create_header(Ver, Head0),
+ StatusLine = [Ver, " ",
+ io_lib:write(StatusCode), " ",
+ httpd_util:reason_phrase(StatusCode), "\r\n"],
+ Connection = get_connection(Conn, Ver),
+ Head = list_to_binary([StatusLine, Head1, Connection,"\r\n"]),
+ ?vtrace("deliver head", []),
+ httpd_socket:deliver(Type, Sock, Head).
+
+
+send_body(_, _, nobody) ->
+ ?vtrace("send_body -> no body", []),
+ ok;
+
+send_body(#mod{socket_type = Type, socket = Sock},
+ StatusCode, Body) when list(Body) ->
+ ?vtrace("deliver body of size ~p", [length(Body)]),
+ httpd_socket:deliver(Type, Sock, Body);
+
+send_body(#mod{socket_type = Type, socket = Sock} = Info,
+ StatusCode, {Fun, Args}) ->
+ case (catch apply(Fun, Args)) of
+ close ->
+ httpd_socket:close(Type, Sock),
+ done;
+
+ sent ->
+ ?PROCEED_RESPONSE(StatusCode, Info);
+
+ {ok, Body} ->
+ ?vtrace("deliver body", []),
+ case httpd_socket:deliver(Type, Sock, Body) of
+ ok ->
+ ?PROCEED_RESPONSE(StatusCode, Info);
+ Error ->
+ ?vlog("body delivery failure: ~p", [Error]),
+ done
+ end;
+
+ Error ->
+ ?vlog("failure of apply(~p,~p): ~p", [Fun, Args, Error]),
+ done
+ end;
+send_body(I, S, B) ->
+ ?vinfo("BAD ARGS: "
+ "~n I: ~p"
+ "~n S: ~p"
+ "~n B: ~p", [I, S, B]),
+ exit({bad_args, {I, S, B}}).
+
+
+%% Return a HTTP-header field that indicates that the
+%% connection will be inpersistent
+get_connection(true,"HTTP/1.0")->
+ "Connection:close\r\n";
+get_connection(false,"HTTP/1.1") ->
+ "Connection:close\r\n";
+get_connection(_,_) ->
+ "".
+
+
+create_header("HTTP/1.1", Data) ->
+ create_header1(?HTTP11HEADERFIELDS, Data);
+create_header(_, Data) ->
+ create_header1(?HTTP10HEADERFIELDS, Data).
+
+create_header1(Fields, Data) ->
+ ?DEBUG("create_header() -> "
+ "~n Fields :~p~n Data: ~p ~n", [Fields, Data]),
+ mapfilter(fun(Field)->
+ transform({Field, httpd_util:key1search(Data, Field)})
+ end, Fields, undefined).
+
+
+%% Do a map and removes the values that evaluates to RemoveVal
+mapfilter(Fun,List,RemoveVal)->
+ mapfilter(Fun,List,[],RemoveVal).
+
+mapfilter(Fun,[],[RemoveVal|Acc],RemoveVal)->
+ Acc;
+mapfilter(Fun,[],Acc,_RemoveVal)->
+ Acc;
+
+mapfilter(Fun,[Elem|Rest],[RemoveVal|Acc],RemoveVal)->
+ mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal);
+mapfilter(Fun,[Elem|Rest],Acc,RemoveVal)->
+ mapfilter(Fun,Rest,[Fun(Elem)|Acc],RemoveVal).
+
+
+transform({content_type,undefined})->
+ ["Content-Type:text/plain\r\n"];
+
+transform({date,undefined})->
+ ["Date:",httpd_util:rfc1123_date(),"\r\n"];
+
+transform({date,RFCDate})->
+ ["Date:",RFCDate,"\r\n"];
+
+
+transform({_Key,undefined})->
+ undefined;
+transform({accept_ranges,Value})->
+ ["Accept-Ranges:",Value,"\r\n"];
+transform({cache_control,Value})->
+ ["Cache-Control:",Value,"\r\n"];
+transform({pragma,Value})->
+ ["Pragma:",Value,"\r\n"];
+transform({trailer,Value})->
+ ["Trailer:",Value,"\r\n"];
+transform({transfer_encoding,Value})->
+ ["Pragma:",Value,"\r\n"];
+transform({etag,Value})->
+ ["ETag:",Value,"\r\n"];
+transform({location,Value})->
+ ["Retry-After:",Value,"\r\n"];
+transform({server,Value})->
+ ["Server:",Value,"\r\n"];
+transform({allow,Value})->
+ ["Allow:",Value,"\r\n"];
+transform({content_encoding,Value})->
+ ["Content-Encoding:",Value,"\r\n"];
+transform({content_language,Value})->
+ ["Content-Language:",Value,"\r\n"];
+transform({retry_after,Value})->
+ ["Retry-After:",Value,"\r\n"];
+transform({server,Value})->
+ ["Server:",Value,"\r\n"];
+transform({allow,Value})->
+ ["Allow:",Value,"\r\n"];
+transform({content_encoding,Value})->
+ ["Content-Encoding:",Value,"\r\n"];
+transform({content_language,Value})->
+ ["Content-Language:",Value,"\r\n"];
+transform({content_location,Value})->
+ ["Content-Location:",Value,"\r\n"];
+transform({content_length,Value})->
+ ["Content-Length:",Value,"\r\n"];
+transform({content_MD5,Value})->
+ ["Content-MD5:",Value,"\r\n"];
+transform({content_range,Value})->
+ ["Content-Range:",Value,"\r\n"];
+transform({content_type,Value})->
+ ["Content-Type:",Value,"\r\n"];
+transform({expires,Value})->
+ ["Expires:",Value,"\r\n"];
+transform({last_modified,Value})->
+ ["Last-Modified:",Value,"\r\n"].
+
+
+
+%%----------------------------------------------------------------------
+%% This is the old way of sending data it is strongly encouraged to
+%% Leave this method and go on to the newer form of response
+%% OTP-4408
+%%----------------------------------------------------------------------
+
+send_response_old(#mod{socket_type = Type,
+ socket = Sock,
+ method = "HEAD"} = Info,
+ StatusCode, Response) ->
+ ?vtrace("send_response_old(HEAD) -> entry with"
+ "~n StatusCode: ~p"
+ "~n Response: ~p",
+ [StatusCode,Response]),
+ case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
+ {ok, [Head, Body]} ->
+ Header =
+ httpd_util:header(StatusCode,Info#mod.connection) ++
+ "Content-Length:" ++ content_length(Body),
+ httpd_socket:deliver(Type, Sock, [Header,Head,"\r\n"]);
+
+ Error ->
+ send_status(Info, 500, "Internal Server Error")
+ end;
+
+send_response_old(#mod{socket_type = Type,
+ socket = Sock} = Info,
+ StatusCode, Response) ->
+ ?vtrace("send_response_old -> entry with"
+ "~n StatusCode: ~p"
+ "~n Response: ~p",
+ [StatusCode,Response]),
+ case httpd_util:split(lists:flatten(Response),"\r\n\r\n|\n\n",2) of
+ {ok, [_Head, Body]} ->
+ Header =
+ httpd_util:header(StatusCode,Info#mod.connection) ++
+ "Content-Length:" ++ content_length(Body),
+ httpd_socket:deliver(Type, Sock, [Header, Response]);
+
+ {ok, Body} ->
+ Header =
+ httpd_util:header(StatusCode,Info#mod.connection) ++
+ "Content-Length:" ++ content_length(Body) ++ "\r\n",
+ httpd_socket:deliver(Type, Sock, [Header, Response]);
+
+ {error, Reason} ->
+ send_status(Info, 500, "Internal Server Error")
+ end.
+
+content_length(Body)->
+ integer_to_list(httpd_util:flatlength(Body))++"\r\n".
+
+
+report_error(Mod, ConfigDB, Error) ->
+ Modules = httpd_util:lookup(ConfigDB, modules,
+ [mod_get, mod_head, mod_log]),
+ case lists:member(Mod, Modules) of
+ true ->
+ Mod:report_error(ConfigDB, Error);
+ _ ->
+ ok
+ end.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_socket.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_socket.erl
new file mode 100644
index 0000000000..95dfc5e824
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_socket.erl
@@ -0,0 +1,381 @@
+%% ``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: httpd_socket.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(httpd_socket).
+-export([start/1,
+ listen/2, listen/3, accept/2, accept/3,
+ deliver/3, send/3, recv/4,
+ close/2,
+ peername/2, resolve/1, config/1,
+ controlling_process/3,
+ active_once/2]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"SOCKET").
+-include("httpd_verbosity.hrl").
+
+-include_lib("kernel/include/inet.hrl").
+
+%% start -> ok | {error,Reason}
+
+start(ip_comm) ->
+ case inet_db:start() of
+ {ok,_Pid} ->
+ ok;
+ {error,{already_started,_Pid}} ->
+ ok;
+ Error ->
+ Error
+ end;
+start({ssl,_SSLConfig}) ->
+ case ssl:start() of
+ ok ->
+ ok;
+ {ok, _} ->
+ ok;
+ {error,{already_started,_}} ->
+ ok;
+ Error ->
+ Error
+ end.
+
+%% listen
+
+listen(SocketType,Port) ->
+ listen(SocketType,undefined,Port).
+
+listen(ip_comm,Addr,Port) ->
+ ?DEBUG("listening(ip_comm) to port ~p", [Port]),
+ Opt = sock_opt(Addr,[{backlog,128},{reuseaddr,true}]),
+ case gen_tcp:listen(Port,Opt) of
+ {ok,ListenSocket} ->
+ ListenSocket;
+ Error ->
+ Error
+ end;
+listen({ssl,SSLConfig},Addr,Port) ->
+ ?DEBUG("listening(ssl) to port ~p"
+ "~n SSLConfig: ~p", [Port,SSLConfig]),
+ Opt = sock_opt(Addr,SSLConfig),
+ case ssl:listen(Port, Opt) of
+ {ok,ListenSocket} ->
+ ListenSocket;
+ Error ->
+ Error
+ end.
+
+
+sock_opt(undefined,Opt) -> [{packet,0},{active,false}|Opt];
+sock_opt(Addr,Opt) -> [{ip, Addr},{packet,0},{active,false}|Opt].
+
+%% -define(packet_type_http,true).
+%% -define(packet_type_httph,true).
+
+%% -ifdef(packet_type_http).
+%% sock_opt(undefined,Opt) -> [{packet,http},{active,false}|Opt];
+%% sock_opt(Addr,Opt) -> [{ip, Addr},{packet,http},{active,false}|Opt].
+%% -elif(packet_type_httph).
+%% sock_opt(undefined,Opt) -> [{packet,httph},{active,false}|Opt];
+%% sock_opt(Addr,Opt) -> [{ip, Addr},{packet,httph},{active,false}|Opt].
+%% -else.
+%% sock_opt(undefined,Opt) -> [{packet,0},{active,false}|Opt];
+%% sock_opt(Addr,Opt) -> [{ip, Addr},{packet,0},{active,false}|Opt].
+%% -endif.
+
+
+%% active_once
+
+active_once(Type, Sock) ->
+ active(Type, Sock, once).
+
+active(ip_comm, Sock, Active) ->
+ inet:setopts(Sock, [{active, Active}]);
+active({ssl, _SSLConfig}, Sock, Active) ->
+ ssl:setopts(Sock, [{active, Active}]).
+
+%% accept
+
+accept(A, B) ->
+ accept(A, B, infinity).
+
+
+accept(ip_comm,ListenSocket, T) ->
+ ?DEBUG("accept(ip_comm) on socket ~p", [ListenSocket]),
+ case gen_tcp:accept(ListenSocket, T) of
+ {ok,Socket} ->
+ Socket;
+ Error ->
+ ?vtrace("accept(ip_comm) failed for reason:"
+ "~n Error: ~p",[Error]),
+ Error
+ end;
+accept({ssl,_SSLConfig},ListenSocket, T) ->
+ ?DEBUG("accept(ssl) on socket ~p", [ListenSocket]),
+ case ssl:accept(ListenSocket, T) of
+ {ok,Socket} ->
+ Socket;
+ Error ->
+ ?vtrace("accept(ssl) failed for reason:"
+ "~n Error: ~p",[Error]),
+ Error
+ end.
+
+
+%% controlling_process
+
+controlling_process(ip_comm, Socket, Pid) ->
+ gen_tcp:controlling_process(Socket, Pid);
+controlling_process({ssl, _}, Socket, Pid) ->
+ ssl:controlling_process(Socket, Pid).
+
+
+%% deliver
+
+deliver(SocketType, Socket, IOListOrBinary) ->
+ case send(SocketType, Socket, IOListOrBinary) of
+% {error, einval} ->
+% ?vlog("deliver failed for reason: einval"
+% "~n SocketType: ~p"
+% "~n Socket: ~p"
+% "~n Data: ~p",
+% [SocketType, Socket, type(IOListOrBinary)]),
+% (catch close(SocketType, Socket)),
+% socket_closed;
+ {error, _Reason} ->
+ ?vlog("deliver(~p) failed for reason:"
+ "~n Reason: ~p",[SocketType,_Reason]),
+ (catch close(SocketType, Socket)),
+ socket_closed;
+ _ ->
+ ok
+ end.
+
+% type(L) when list(L) ->
+% {list, L};
+% type(B) when binary(B) ->
+% Decoded =
+% case (catch binary_to_term(B)) of
+% {'EXIT', _} ->
+% %% Oups, not a term, try list
+% case (catch binary_to_list(B)) of
+% %% Oups, not a list either, give up
+% {'EXIT', _} ->
+% {size, size(B)};
+% L ->
+% {list, L}
+% end;
+
+% T ->
+% {term, T}
+% end,
+% {binary, Decoded};
+% type(T) when tuple(T) ->
+% {tuple, T};
+% type(I) when integer(I) ->
+% {integer, I};
+% type(F) when float(F) ->
+% {float, F};
+% type(P) when pid(P) ->
+% {pid, P};
+% type(P) when port(P) ->
+% {port, P};
+% type(R) when reference(R) ->
+% {reference, R};
+% type(T) ->
+% {term, T}.
+
+
+
+send(ip_comm,Socket,Data) ->
+ ?DEBUG("send(ip_comm) -> ~p bytes on socket ~p",[data_size(Data),Socket]),
+ gen_tcp:send(Socket,Data);
+send({ssl,SSLConfig},Socket,Data) ->
+ ?DEBUG("send(ssl) -> ~p bytes on socket ~p",[data_size(Data),Socket]),
+ ssl:send(Socket, Data).
+
+recv(ip_comm,Socket,Length,Timeout) ->
+ ?DEBUG("recv(ip_comm) -> read from socket ~p",[Socket]),
+ gen_tcp:recv(Socket,Length,Timeout);
+recv({ssl,SSLConfig},Socket,Length,Timeout) ->
+ ?DEBUG("recv(ssl) -> read from socket ~p",[Socket]),
+ ssl:recv(Socket,Length,Timeout).
+
+-ifdef(inets_debug).
+data_size(L) when list(L) ->
+ httpd_util:flatlength(L);
+data_size(B) when binary(B) ->
+ size(B);
+data_size(O) ->
+ {unknown_size,O}.
+-endif.
+
+
+%% peername
+
+peername(ip_comm, Socket) ->
+ case inet:peername(Socket) of
+ {ok,{{A,B,C,D},Port}} ->
+ PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++
+ integer_to_list(C)++"."++integer_to_list(D),
+ ?DEBUG("peername(ip_comm) on socket ~p: ~p",
+ [Socket,{Port,PeerName}]),
+ {Port,PeerName};
+ {error,Reason} ->
+ ?vlog("failed getting peername:"
+ "~n Reason: ~p"
+ "~n Socket: ~p",
+ [Reason,Socket]),
+ {-1,"unknown"}
+ end;
+peername({ssl,_SSLConfig},Socket) ->
+ case ssl:peername(Socket) of
+ {ok,{{A,B,C,D},Port}} ->
+ PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++
+ integer_to_list(C)++"."++integer_to_list(D),
+ ?DEBUG("peername(ssl) on socket ~p: ~p",
+ [Socket, {Port,PeerName}]),
+ {Port,PeerName};
+ {error,_Reason} ->
+ {-1,"unknown"}
+ end.
+
+%% resolve
+
+resolve(_) ->
+ {ok,Name} = inet:gethostname(),
+ Name.
+
+%% close
+
+close(ip_comm,Socket) ->
+ Res =
+ case (catch gen_tcp:close(Socket)) of
+ ok -> ok;
+ {error,Reason} -> {error,Reason};
+ {'EXIT',{noproc,_}} -> {error,closed};
+ {'EXIT',Reason} -> {error,Reason};
+ Otherwise -> {error,Otherwise}
+ end,
+ ?vtrace("close(ip_comm) result: ~p",[Res]),
+ Res;
+close({ssl,_SSLConfig},Socket) ->
+ Res =
+ case (catch ssl:close(Socket)) of
+ ok -> ok;
+ {error,Reason} -> {error,Reason};
+ {'EXIT',{noproc,_}} -> {error,closed};
+ {'EXIT',Reason} -> {error,Reason};
+ Otherwise -> {error,Otherwise}
+ end,
+ ?vtrace("close(ssl) result: ~p",[Res]),
+ Res.
+
+%% config (debug: {certfile, "/var/tmp/server_root/conf/ssl_server.pem"})
+
+config(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB,com_type,ip_comm) of
+ ssl ->
+ case ssl_certificate_file(ConfigDB) of
+ undefined ->
+ {error,
+ ?NICE("Directive SSLCertificateFile "
+ "not found in the config file")};
+ SSLCertificateFile ->
+ {ssl,
+ SSLCertificateFile++
+ ssl_certificate_key_file(ConfigDB)++
+ ssl_verify_client(ConfigDB)++
+ ssl_ciphers(ConfigDB)++
+ ssl_password(ConfigDB)++
+ ssl_verify_depth(ConfigDB)++
+ ssl_ca_certificate_file(ConfigDB)}
+ end;
+ ip_comm ->
+ ip_comm
+ end.
+
+ssl_certificate_file(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB,ssl_certificate_file) of
+ undefined ->
+ undefined;
+ SSLCertificateFile ->
+ [{certfile,SSLCertificateFile}]
+ end.
+
+ssl_certificate_key_file(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB,ssl_certificate_key_file) of
+ undefined ->
+ [];
+ SSLCertificateKeyFile ->
+ [{keyfile,SSLCertificateKeyFile}]
+ end.
+
+ssl_verify_client(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB,ssl_verify_client) of
+ undefined ->
+ [];
+ SSLVerifyClient ->
+ [{verify,SSLVerifyClient}]
+ end.
+
+ssl_ciphers(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB,ssl_ciphers) of
+ undefined ->
+ [];
+ Ciphers ->
+ [{ciphers, Ciphers}]
+ end.
+
+ssl_password(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB,ssl_password_callback_module) of
+ undefined ->
+ [];
+ Module ->
+ case httpd_util:lookup(ConfigDB, ssl_password_callback_function) of
+ undefined ->
+ [];
+ Function ->
+ case catch apply(Module, Function, []) of
+ Password when list(Password) ->
+ [{password, Password}];
+ Error ->
+ error_report(ssl_password,Module,Function,Error),
+ []
+ end
+ end
+ end.
+
+ssl_verify_depth(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB, ssl_verify_client_depth) of
+ undefined ->
+ [];
+ Depth ->
+ [{depth, Depth}]
+ end.
+
+ssl_ca_certificate_file(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB, ssl_ca_certificate_file) of
+ undefined ->
+ [];
+ File ->
+ [{cacertfile, File}]
+ end.
+
+
+error_report(Where,M,F,Error) ->
+ error_logger:error_report([{?MODULE, Where}, {apply, {M, F, []}}, Error]).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_sup.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_sup.erl
new file mode 100644
index 0000000000..fd557c30db
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_sup.erl
@@ -0,0 +1,203 @@
+%% ``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: httpd_sup.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for the inets application
+%%----------------------------------------------------------------------
+
+-module(httpd_sup).
+
+-behaviour(supervisor).
+
+-include("httpd_verbosity.hrl").
+
+%% public
+-export([start/2, start_link/2, start2/2, start_link2/2, stop/1, stop/2, stop2/1]).
+-export([init/1]).
+
+
+-define(D(F, A), io:format("~p:" ++ F ++ "~n", [?MODULE|A])).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% supervisor callback functions
+
+start(ConfigFile, Verbosity) ->
+ case start_link(ConfigFile, Verbosity) of
+ {ok, Pid} ->
+ unlink(Pid),
+ {ok, Pid};
+
+ Else ->
+ Else
+ end.
+
+
+start_link(ConfigFile, Verbosity) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok, ConfigList, Addr, Port} ->
+ Name = make_name(Addr, Port),
+ SupName = {local, Name},
+ supervisor:start_link(SupName, ?MODULE,
+ [ConfigFile, ConfigList,
+ Verbosity, Addr, Port]);
+
+ {error, Reason} ->
+ error_logger:error_report(Reason),
+ {stop, Reason};
+
+ Else ->
+ error_logger:error_report(Else),
+ {stop, Else}
+ end.
+
+
+start2(ConfigList, Verbosity) ->
+ case start_link2(ConfigList, Verbosity) of
+ {ok, Pid} ->
+ unlink(Pid),
+ {ok, Pid};
+
+ Else ->
+ Else
+ end.
+
+
+start_link2(ConfigList, Verbosity) ->
+ case get_addr_and_port2(ConfigList) of
+ {ok, Addr, Port} ->
+ Name = make_name(Addr, Port),
+ SupName = {local, Name},
+ supervisor:start_link(SupName, ?MODULE,
+ [undefined, ConfigList, Verbosity, Addr, Port]);
+
+ {error, Reason} ->
+ error_logger:error_report(Reason),
+ {stop, Reason};
+
+ Else ->
+ error_logger:error_report(Else),
+ {stop, Else}
+ end.
+
+
+
+stop(Pid) when pid(Pid) ->
+ do_stop(Pid);
+stop(ConfigFile) when list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok, _, Addr, Port} ->
+ stop(Addr, Port);
+
+ Error ->
+ Error
+ end;
+stop(StartArgs) ->
+ ok.
+
+
+stop(Addr, Port) when integer(Port) ->
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ Pid when pid(Pid) ->
+ do_stop(Pid),
+ ok;
+ _ ->
+ not_started
+ end.
+
+stop2(ConfigList) when list(ConfigList) ->
+ {ok, Addr, Port} = get_addr_and_port2(ConfigList),
+ stop(Addr, Port).
+
+
+do_stop(Pid) ->
+ exit(Pid, shutdown).
+
+
+init([ConfigFile, ConfigList, Verbosity, Addr, Port]) ->
+ init(ConfigFile, ConfigList, Verbosity, Addr, Port);
+init(BadArg) ->
+ {error, {badarg, BadArg}}.
+
+init(ConfigFile, ConfigList, Verbosity, Addr, Port) ->
+ Flags = {one_for_one, 0, 1},
+ AccSupVerbosity = get_acc_sup_verbosity(Verbosity),
+ MiscSupVerbosity = get_misc_sup_verbosity(Verbosity),
+ Sups = [sup_spec(httpd_acceptor_sup, Addr, Port, AccSupVerbosity),
+ sup_spec(httpd_misc_sup, Addr, Port, MiscSupVerbosity),
+ worker_spec(httpd_manager, Addr, Port, ConfigFile, ConfigList,
+ Verbosity, [gen_server])],
+ {ok, {Flags, Sups}}.
+
+
+sup_spec(Name, Addr, Port, Verbosity) ->
+ {{Name, Addr, Port},
+ {Name, start, [Addr, Port, Verbosity]},
+ permanent, 2000, supervisor, [Name, supervisor]}.
+
+worker_spec(Name, Addr, Port, ConfigFile, ConfigList, Verbosity, Modules) ->
+ {{Name, Addr, Port},
+ {Name, start_link, [ConfigFile, ConfigList, Verbosity]},
+ permanent, 2000, worker, [Name] ++ Modules}.
+
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd_sup",Addr,Port).
+
+
+%% get_addr_and_port
+
+get_addr_and_port(ConfigFile) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ {ok, Addr, Port} = get_addr_and_port2(ConfigList),
+ {ok, ConfigList, Addr, Port};
+ Error ->
+ Error
+ end.
+
+
+get_addr_and_port2(ConfigList) ->
+ Port = httpd_util:key1search(ConfigList, port, 80),
+ Addr = httpd_util:key1search(ConfigList, bind_address),
+ {ok, Addr, Port}.
+
+get_acc_sup_verbosity(V) ->
+ case key1search(V, all) of
+ undefined ->
+ key1search(V, acceptor_sup_verbosity, ?default_verbosity);
+ Verbosity ->
+ Verbosity
+ end.
+
+
+get_misc_sup_verbosity(V) ->
+ case key1search(V, all) of
+ undefined ->
+ key1search(V, misc_sup_verbosity, ?default_verbosity);
+ Verbosity ->
+ Verbosity
+ end.
+
+
+key1search(L, K) ->
+ httpd_util:key1search(L, K).
+
+key1search(L, K, D) ->
+ httpd_util:key1search(L, K, D).
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_util.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_util.erl
new file mode 100644
index 0000000000..05064a8d38
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_util.erl
@@ -0,0 +1,777 @@
+%% ``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: httpd_util.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(httpd_util).
+-export([key1search/2, key1search/3, lookup/2, lookup/3, multi_lookup/2,
+ lookup_mime/2, lookup_mime/3, lookup_mime_default/2,
+ lookup_mime_default/3, reason_phrase/1, message/3, rfc1123_date/0,
+ rfc1123_date/1, day/1, month/1, decode_hex/1, decode_base64/1, encode_base64/1,
+ flatlength/1, split_path/1, split_script_path/1, suffix/1, to_upper/1,
+ to_lower/1, split/3, header/2, header/3, header/4, uniq/1,
+ make_name/2,make_name/3,make_name/4,strip/1,
+ hexlist_to_integer/1,integer_to_hexlist/1,
+ convert_request_date/1,create_etag/1,create_etag/2,getSize/1,
+ response_generated/1]).
+
+%%Since hexlist_to_integer is a lousy name make a name convert
+-export([encode_hex/1]).
+-include("httpd.hrl").
+
+%% key1search
+
+key1search(TupleList,Key) ->
+ key1search(TupleList,Key,undefined).
+
+key1search(TupleList,Key,Undefined) ->
+ case lists:keysearch(Key,1,TupleList) of
+ {value,{Key,Value}} ->
+ Value;
+ false ->
+ Undefined
+ end.
+
+%% lookup
+
+lookup(Table,Key) ->
+ lookup(Table,Key,undefined).
+
+lookup(Table,Key,Undefined) ->
+ case catch ets:lookup(Table,Key) of
+ [{Key,Value}|_] ->
+ Value;
+ _->
+ Undefined
+ end.
+
+%% multi_lookup
+
+multi_lookup(Table,Key) ->
+ remove_key(ets:lookup(Table,Key)).
+
+remove_key([]) ->
+ [];
+remove_key([{_Key,Value}|Rest]) ->
+ [Value|remove_key(Rest)].
+
+%% lookup_mime
+
+lookup_mime(ConfigDB,Suffix) ->
+ lookup_mime(ConfigDB,Suffix,undefined).
+
+lookup_mime(ConfigDB,Suffix,Undefined) ->
+ [{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
+ case ets:lookup(MimeTypesDB,Suffix) of
+ [] ->
+ Undefined;
+ [{Suffix,MimeType}|_] ->
+ MimeType
+ end.
+
+%% lookup_mime_default
+
+lookup_mime_default(ConfigDB,Suffix) ->
+ lookup_mime_default(ConfigDB,Suffix,undefined).
+
+lookup_mime_default(ConfigDB,Suffix,Undefined) ->
+ [{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
+ case ets:lookup(MimeTypesDB,Suffix) of
+ [] ->
+ case ets:lookup(ConfigDB,default_type) of
+ [] ->
+ Undefined;
+ [{default_type,DefaultType}|_] ->
+ DefaultType
+ end;
+ [{Suffix,MimeType}|_] ->
+ MimeType
+ end.
+
+%% reason_phrase
+reason_phrase(100) -> "Continue";
+reason_phrase(101) -> "Swithing protocol";
+reason_phrase(200) -> "OK";
+reason_phrase(201) -> "Created";
+reason_phrase(202) -> "Accepted";
+reason_phrase(204) -> "No Content";
+reason_phrase(205) -> "Reset Content";
+reason_phrase(206) -> "Partial Content";
+reason_phrase(301) -> "Moved Permanently";
+reason_phrase(302) -> "Moved Temporarily";
+reason_phrase(304) -> "Not Modified";
+reason_phrase(400) -> "Bad Request";
+reason_phrase(401) -> "Unauthorized";
+reason_phrase(402) -> "Payment Required";
+reason_phrase(403) -> "Forbidden";
+reason_phrase(404) -> "Not Found";
+reason_phrase(405) -> "Method Not Allowed";
+reason_phrase(408) -> "Request Timeout";
+reason_phrase(411) -> "Length Required";
+reason_phrase(414) -> "Request-URI Too Long";
+reason_phrase(412) -> "Precondition Failed";
+reason_phrase(416) -> "request Range Not Satisfiable";
+reason_phrase(417) -> "Expectation failed";
+reason_phrase(500) -> "Internal Server Error";
+reason_phrase(501) -> "Not Implemented";
+reason_phrase(502) -> "Bad Gateway";
+reason_phrase(503) -> "Service Unavailable";
+reason_phrase(_) -> "Internal Server Error".
+
+%% message
+
+message(301,URL,_) ->
+ "The document has moved <A HREF=\""++URL++"\">here</A>.";
+message(304,_URL,_) ->
+ "The document has not been changed.";
+message(400,none,_) ->
+ "Your browser sent a query that this server could not understand.";
+message(401,none,_) ->
+ "This server could not verify that you
+are authorized to access the document you
+requested. Either you supplied the wrong
+credentials (e.g., bad password), or your
+browser does not understand how to supply
+the credentials required.";
+message(403,RequestURI,_) ->
+ "You do not have permission to access "++RequestURI++" on this server.";
+message(404,RequestURI,_) ->
+ "The requested URL "++RequestURI++" was not found on this server.";
+message(412,none,_) ->
+ "The requested preconditions where false";
+message(414,ReasonPhrase,_) ->
+ "Message "++ReasonPhrase++".";
+message(416,ReasonPhrase,_) ->
+ ReasonPhrase;
+
+message(500,none,ConfigDB) ->
+ ServerAdmin=lookup(ConfigDB,server_admin,"unknown@unknown"),
+ "The server encountered an internal error or
+misconfiguration and was unable to complete
+your request.
+<P>Please contact the server administrator "++ServerAdmin++",
+and inform them of the time the error occurred
+and anything you might have done that may have
+caused the error.";
+message(501,{Method,RequestURI,HTTPVersion},_ConfigDB) ->
+ Method++" to "++RequestURI++" ("++HTTPVersion++") not supported.";
+message(503,String,_ConfigDB) ->
+ "This service in unavailable due to: "++String.
+
+%%convert_rfc_date(Date)->{{YYYY,MM,DD},{HH,MIN,SEC}}
+
+convert_request_date([D,A,Y,DateType|Rest]) ->
+ Func=case DateType of
+ $\, ->
+ fun convert_rfc1123_date/1;
+ $\ ->
+ fun convert_ascii_date/1;
+ _ ->
+ fun convert_rfc850_date/1
+ end,
+ case catch Func([D,A,Y,DateType|Rest])of
+ {ok,Date} ->
+ Date;
+ _Error ->
+ bad_date
+ end.
+
+convert_rfc850_date(DateStr) ->
+ case string:tokens(DateStr," ") of
+ [_WeekDay,Date,Time,_TimeZone|_Rest] ->
+ convert_rfc850_date(Date,Time);
+ _Error ->
+ bad_date
+ end.
+
+convert_rfc850_date([D1,D2,_,M,O,N,_,Y1,Y2|_Rest],[H1,H2,_Col,M1,M2,_Col,S1,S2|_Rest2])->
+ Year=list_to_integer([50,48,Y1,Y2]),
+ Day=list_to_integer([D1,D2]),
+ Month=convert_month([M,O,N]),
+ Hour=list_to_integer([H1,H2]),
+ Min=list_to_integer([M1,M2]),
+ Sec=list_to_integer([S1,S2]),
+ {ok,{{Year,Month,Day},{Hour,Min,Sec}}};
+convert_rfc850_date(_BadDate,_BadTime)->
+ bad_date.
+
+convert_ascii_date([_D,_A,_Y,_SP,M,O,N,_SP,D1,D2,_SP,H1,H2,_Col,M1,M2,_Col,S1,S2,_SP,Y1,Y2,Y3,Y4|_Rest])->
+ Year=list_to_integer([Y1,Y2,Y3,Y4]),
+ Day=case D1 of
+ $\ ->
+ list_to_integer([D2]);
+ _->
+ list_to_integer([D1,D2])
+ end,
+ Month=convert_month([M,O,N]),
+ Hour=list_to_integer([H1,H2]),
+ Min=list_to_integer([M1,M2]),
+ Sec=list_to_integer([S1,S2]),
+ {ok,{{Year,Month,Day},{Hour,Min,Sec}}};
+convert_ascii_date(BadDate)->
+ bad_date.
+convert_rfc1123_date([_D,_A,_Y,_C,_SP,D1,D2,_SP,M,O,N,_SP,Y1,Y2,Y3,Y4,_SP,H1,H2,_Col,M1,M2,_Col,S1,S2|Rest])->
+ Year=list_to_integer([Y1,Y2,Y3,Y4]),
+ Day=list_to_integer([D1,D2]),
+ Month=convert_month([M,O,N]),
+ Hour=list_to_integer([H1,H2]),
+ Min=list_to_integer([M1,M2]),
+ Sec=list_to_integer([S1,S2]),
+ {ok,{{Year,Month,Day},{Hour,Min,Sec}}};
+convert_rfc1123_date(BadDate)->
+ bad_date.
+
+convert_month("Jan")->1;
+convert_month("Feb") ->2;
+convert_month("Mar") ->3;
+convert_month("Apr") ->4;
+convert_month("May") ->5;
+convert_month("Jun") ->6;
+convert_month("Jul") ->7;
+convert_month("Aug") ->8;
+convert_month("Sep") ->9;
+convert_month("Oct") ->10;
+convert_month("Nov") ->11;
+convert_month("Dec") ->12.
+
+
+%% rfc1123_date
+
+rfc1123_date() ->
+ {{YYYY,MM,DD},{Hour,Min,Sec}}=calendar:universal_time(),
+ DayNumber=calendar:day_of_the_week({YYYY,MM,DD}),
+ lists:flatten(io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
+ [day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
+
+rfc1123_date({{YYYY,MM,DD},{Hour,Min,Sec}}) ->
+ DayNumber=calendar:day_of_the_week({YYYY,MM,DD}),
+ lists:flatten(io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
+ [day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
+
+%% uniq
+
+uniq([]) ->
+ [];
+uniq([First,First|Rest]) ->
+ uniq([First|Rest]);
+uniq([First|Rest]) ->
+ [First|uniq(Rest)].
+
+
+%% day
+
+day(1) -> "Mon";
+day(2) -> "Tue";
+day(3) -> "Wed";
+day(4) -> "Thu";
+day(5) -> "Fri";
+day(6) -> "Sat";
+day(7) -> "Sun".
+
+%% month
+
+month(1) -> "Jan";
+month(2) -> "Feb";
+month(3) -> "Mar";
+month(4) -> "Apr";
+month(5) -> "May";
+month(6) -> "Jun";
+month(7) -> "Jul";
+month(8) -> "Aug";
+month(9) -> "Sep";
+month(10) -> "Oct";
+month(11) -> "Nov";
+month(12) -> "Dec".
+
+%% decode_hex
+
+decode_hex([$%,Hex1,Hex2|Rest]) ->
+ [hex2dec(Hex1)*16+hex2dec(Hex2)|decode_hex(Rest)];
+decode_hex([First|Rest]) ->
+ [First|decode_hex(Rest)];
+decode_hex([]) ->
+ [].
+
+hex2dec(X) when X>=$0,X=<$9 -> X-$0;
+hex2dec(X) when X>=$A,X=<$F -> X-$A+10;
+hex2dec(X) when X>=$a,X=<$f -> X-$a+10.
+
+%% decode_base64 (DEBUG STRING: QWxhZGRpbjpvcGVuIHNlc2FtZQ==)
+
+decode_base64([]) ->
+ [];
+decode_base64([Sextet1,Sextet2,$=,$=|Rest]) ->
+ Bits2x6=
+ (d(Sextet1) bsl 18) bor
+ (d(Sextet2) bsl 12),
+ Octet1=Bits2x6 bsr 16,
+ [Octet1|decode_base64(Rest)];
+decode_base64([Sextet1,Sextet2,Sextet3,$=|Rest]) ->
+ Bits3x6=
+ (d(Sextet1) bsl 18) bor
+ (d(Sextet2) bsl 12) bor
+ (d(Sextet3) bsl 6),
+ Octet1=Bits3x6 bsr 16,
+ Octet2=(Bits3x6 bsr 8) band 16#ff,
+ [Octet1,Octet2|decode_base64(Rest)];
+decode_base64([Sextet1,Sextet2,Sextet3,Sextet4|Rest]) ->
+ Bits4x6=
+ (d(Sextet1) bsl 18) bor
+ (d(Sextet2) bsl 12) bor
+ (d(Sextet3) bsl 6) bor
+ d(Sextet4),
+ Octet1=Bits4x6 bsr 16,
+ Octet2=(Bits4x6 bsr 8) band 16#ff,
+ Octet3=Bits4x6 band 16#ff,
+ [Octet1,Octet2,Octet3|decode_base64(Rest)];
+decode_base64(CatchAll) ->
+ "BAD!".
+
+d(X) when X >= $A, X =<$Z ->
+ X-65;
+d(X) when X >= $a, X =<$z ->
+ X-71;
+d(X) when X >= $0, X =<$9 ->
+ X+4;
+d($+) -> 62;
+d($/) -> 63;
+d(_) -> 63.
+
+
+encode_base64([]) ->
+ [];
+encode_base64([A]) ->
+ [e(A bsr 2), e((A band 3) bsl 4), $=, $=];
+encode_base64([A,B]) ->
+ [e(A bsr 2), e(((A band 3) bsl 4) bor (B bsr 4)), e((B band 15) bsl 2), $=];
+encode_base64([A,B,C|Ls]) ->
+ encode_base64_do(A,B,C, Ls).
+encode_base64_do(A,B,C, Rest) ->
+ BB = (A bsl 16) bor (B bsl 8) bor C,
+ [e(BB bsr 18), e((BB bsr 12) band 63),
+ e((BB bsr 6) band 63), e(BB band 63)|encode_base64(Rest)].
+
+e(X) when X >= 0, X < 26 -> X+65;
+e(X) when X>25, X<52 -> X+71;
+e(X) when X>51, X<62 -> X-4;
+e(62) -> $+;
+e(63) -> $/;
+e(X) -> exit({bad_encode_base64_token, X}).
+
+
+%% flatlength
+
+flatlength(List) ->
+ flatlength(List, 0).
+
+flatlength([H|T],L) when list(H) ->
+ flatlength(H,flatlength(T,L));
+flatlength([H|T],L) when binary(H) ->
+ flatlength(T,L+size(H));
+flatlength([H|T],L) ->
+ flatlength(T,L+1);
+flatlength([],L) ->
+ L.
+
+%% split_path
+
+split_path(Path) ->
+ case regexp:match(Path,"[\?].*\$") of
+ %% A QUERY_STRING exists!
+ {match,Start,Length} ->
+ {httpd_util:decode_hex(string:substr(Path,1,Start-1)),
+ string:substr(Path,Start,Length)};
+ %% A possible PATH_INFO exists!
+ nomatch ->
+ split_path(Path,[])
+ end.
+
+split_path([],SoFar) ->
+ {httpd_util:decode_hex(lists:reverse(SoFar)),[]};
+split_path([$/|Rest],SoFar) ->
+ Path=httpd_util:decode_hex(lists:reverse(SoFar)),
+ case file:read_file_info(Path) of
+ {ok,FileInfo} when FileInfo#file_info.type == regular ->
+ {Path,[$/|Rest]};
+ {ok,FileInfo} ->
+ split_path(Rest,[$/|SoFar]);
+ {error,Reason} ->
+ split_path(Rest,[$/|SoFar])
+ end;
+split_path([C|Rest],SoFar) ->
+ split_path(Rest,[C|SoFar]).
+
+%% split_script_path
+
+split_script_path(Path) ->
+ case split_script_path(Path, []) of
+ {Script, AfterPath} ->
+ {PathInfo, QueryString} = pathinfo_querystring(AfterPath),
+ {Script, {PathInfo, QueryString}};
+ not_a_script ->
+ not_a_script
+ end.
+
+pathinfo_querystring(Str) ->
+ pathinfo_querystring(Str, []).
+pathinfo_querystring([], SoFar) ->
+ {lists:reverse(SoFar), []};
+pathinfo_querystring([$?|Rest], SoFar) ->
+ {lists:reverse(SoFar), Rest};
+pathinfo_querystring([C|Rest], SoFar) ->
+ pathinfo_querystring(Rest, [C|SoFar]).
+
+split_script_path([$?|QueryString], SoFar) ->
+ Path = httpd_util:decode_hex(lists:reverse(SoFar)),
+ case file:read_file_info(Path) of
+ {ok,FileInfo} when FileInfo#file_info.type == regular ->
+ {Path, [$?|QueryString]};
+ {ok,FileInfo} ->
+ not_a_script;
+ {error,Reason} ->
+ not_a_script
+ end;
+split_script_path([], SoFar) ->
+ Path = httpd_util:decode_hex(lists:reverse(SoFar)),
+ case file:read_file_info(Path) of
+ {ok,FileInfo} when FileInfo#file_info.type == regular ->
+ {Path, []};
+ {ok,FileInfo} ->
+ not_a_script;
+ {error,Reason} ->
+ not_a_script
+ end;
+split_script_path([$/|Rest], SoFar) ->
+ Path = httpd_util:decode_hex(lists:reverse(SoFar)),
+ case file:read_file_info(Path) of
+ {ok, FileInfo} when FileInfo#file_info.type == regular ->
+ {Path, [$/|Rest]};
+ {ok, _FileInfo} ->
+ split_script_path(Rest, [$/|SoFar]);
+ {error, _Reason} ->
+ split_script_path(Rest, [$/|SoFar])
+ end;
+split_script_path([C|Rest], SoFar) ->
+ split_script_path(Rest,[C|SoFar]).
+
+%% suffix
+
+suffix(Path) ->
+ case filename:extension(Path) of
+ [] ->
+ [];
+ Extension ->
+ tl(Extension)
+ end.
+
+%% to_upper
+
+to_upper([C|Cs]) when C >= $a, C =< $z ->
+ [C-($a-$A)|to_upper(Cs)];
+to_upper([C|Cs]) ->
+ [C|to_upper(Cs)];
+to_upper([]) ->
+ [].
+
+%% to_lower
+
+to_lower([C|Cs]) when C >= $A, C =< $Z ->
+ [C+($a-$A)|to_lower(Cs)];
+to_lower([C|Cs]) ->
+ [C|to_lower(Cs)];
+to_lower([]) ->
+ [].
+
+
+%% strip
+strip(Value)->
+ lists:reverse(remove_ws(lists:reverse(remove_ws(Value)))).
+
+remove_ws([$\s|Rest])->
+ remove_ws(Rest);
+remove_ws([$\t|Rest]) ->
+ remove_ws(Rest);
+remove_ws(Rest) ->
+ Rest.
+
+%% split
+
+split(String,RegExp,Limit) ->
+ case regexp:parse(RegExp) of
+ {error,Reason} ->
+ {error,Reason};
+ {ok,_} ->
+ {ok,do_split(String,RegExp,Limit)}
+ end.
+
+do_split(String,RegExp,1) ->
+ [String];
+
+do_split(String,RegExp,Limit) ->
+ case regexp:first_match(String,RegExp) of
+ {match,Start,Length} ->
+ [string:substr(String,1,Start-1)|
+ do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)];
+ nomatch ->
+ [String]
+ end.
+
+%% header
+header(StatusCode,Date)when list(Date)->
+ header(StatusCode,"text/plain",false);
+
+header(StatusCode, PersistentConnection) when integer(StatusCode)->
+ Date = rfc1123_date(),
+ Connection =
+ case PersistentConnection of
+ true ->
+ "";
+ _ ->
+ "Connection: close \r\n"
+ end,
+ io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n~s",
+ [StatusCode, httpd_util:reason_phrase(StatusCode),
+ Date, ?SERVER_SOFTWARE, Connection]).
+
+%%----------------------------------------------------------------------
+
+header(StatusCode, MimeType, Date) when list(Date) ->
+ header(StatusCode, MimeType, false,rfc1123_date());
+
+
+header(StatusCode, MimeType, PersistentConnection) when integer(StatusCode) ->
+ header(StatusCode, MimeType, PersistentConnection,rfc1123_date()).
+
+
+%%----------------------------------------------------------------------
+
+header(416, MimeType,PersistentConnection,Date)->
+ Connection =
+ case PersistentConnection of
+ true ->
+ "";
+ _ ->
+ "Connection: close \r\n"
+ end,
+ io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n"
+ "Content-Range:bytes *"
+ "Content-Type: ~s\r\n~s",
+ [416, httpd_util:reason_phrase(416),
+ Date, ?SERVER_SOFTWARE, MimeType, Connection]);
+
+
+header(StatusCode, MimeType,PersistentConnection,Date) when integer(StatusCode)->
+ Connection =
+ case PersistentConnection of
+ true ->
+ "";
+ _ ->
+ "Connection: close \r\n"
+ end,
+ io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n"
+ "Content-Type: ~s\r\n~s",
+ [StatusCode, httpd_util:reason_phrase(StatusCode),
+ Date, ?SERVER_SOFTWARE, MimeType, Connection]).
+
+
+
+%% make_name/2, make_name/3
+%% Prefix -> string()
+%% First part of the name, e.g. "httpd"
+%% Addr -> {A,B,C,D} | string() | undefined
+%% The address part of the name.
+%% e.g. "123.234.55.66" or {123,234,55,66} or "otp.ericsson.se"
+%% for a host address or undefined if local host.
+%% Port -> integer()
+%% Last part of the name, such as the HTTPD server port
+%% number (80).
+%% Postfix -> Any string that will be added last to the name
+%%
+%% Example:
+%% make_name("httpd","otp.ericsson.se",80) => httpd__otp_ericsson_se__80
+%% make_name("httpd",undefined,8088) => httpd_8088
+
+make_name(Prefix,Port) ->
+ make_name(Prefix,undefined,Port,"").
+
+make_name(Prefix,Addr,Port) ->
+ make_name(Prefix,Addr,Port,"").
+
+make_name(Prefix,"*",Port,Postfix) ->
+ make_name(Prefix,undefined,Port,Postfix);
+
+make_name(Prefix,any,Port,Postfix) ->
+ make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
+
+make_name(Prefix,undefined,Port,Postfix) ->
+ make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
+
+make_name(Prefix,Addr,Port,Postfix) ->
+ NameString =
+ Prefix ++ "__" ++ make_name2(Addr) ++ "__" ++
+ integer_to_list(Port) ++ Postfix,
+ make_name1(NameString).
+
+make_name1(String) ->
+ list_to_atom(lists:flatten(String)).
+
+make_name2({A,B,C,D}) ->
+ io_lib:format("~w_~w_~w_~w",[A,B,C,D]);
+make_name2(Addr) ->
+ search_and_replace(Addr,$.,$_).
+
+search_and_replace(S,A,B) ->
+ Fun = fun(What) ->
+ case What of
+ A -> B;
+ O -> O
+ end
+ end,
+ lists:map(Fun,S).
+
+
+
+%%----------------------------------------------------------------------
+%% Converts a string that constists of 0-9,A-F,a-f to a
+%% integer
+%%----------------------------------------------------------------------
+
+hexlist_to_integer([])->
+ empty;
+
+
+%%When the string only contains one value its eaasy done.
+%% 0-9
+hexlist_to_integer([Size]) when Size>=48 , Size=<57 ->
+ Size-48;
+%% A-F
+hexlist_to_integer([Size]) when Size>=65 , Size=<70 ->
+ Size-55;
+%% a-f
+hexlist_to_integer([Size]) when Size>=97 , Size=<102 ->
+ Size-87;
+hexlist_to_integer([Size]) ->
+ not_a_num;
+
+hexlist_to_integer(Size) ->
+ Len=string:span(Size,"1234567890abcdefABCDEF"),
+ hexlist_to_integer2(Size,16 bsl (4 *(Len-2)),0).
+
+hexlist_to_integer2([],_Pos,Sum)->
+ Sum;
+hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=48,HexVal=<57->
+ hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-48)*Pos));
+
+hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=65,HexVal=<70->
+ hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-55)*Pos));
+
+hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=97,HexVal=<102->
+ hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-87)*Pos));
+
+hexlist_to_integer2(_AfterHexString,_Pos,Sum)->
+ Sum.
+
+%%----------------------------------------------------------------------
+%%Converts an integer to an hexlist
+%%----------------------------------------------------------------------
+encode_hex(Num)->
+ integer_to_hexlist(Num).
+
+
+integer_to_hexlist(Num)->
+ integer_to_hexlist(Num,getSize(Num),[]).
+
+integer_to_hexlist(Num,Pot,Res) when Pot<0 ->
+ convert_to_ascii([Num|Res]);
+
+integer_to_hexlist(Num,Pot,Res) ->
+ Position=(16 bsl (Pot*4)),
+ PosVal=Num div Position,
+ integer_to_hexlist(Num-(PosVal*Position),Pot-1,[PosVal|Res]).
+convert_to_ascii(RevesedNum)->
+ convert_to_ascii(RevesedNum,[]).
+
+convert_to_ascii([],Num)->
+ Num;
+convert_to_ascii([Num|Reversed],Number)when Num>-1, Num<10 ->
+ convert_to_ascii(Reversed,[Num+48|Number]);
+convert_to_ascii([Num|Reversed],Number)when Num>9, Num<16 ->
+ convert_to_ascii(Reversed,[Num+55|Number]);
+convert_to_ascii(NumReversed,Number) ->
+ error.
+
+
+
+getSize(Num)->
+ getSize(Num,0).
+
+getSize(Num,Pot)when Num<(16 bsl(Pot *4)) ->
+ Pot-1;
+
+getSize(Num,Pot) ->
+ getSize(Num,Pot+1).
+
+
+
+
+
+create_etag(FileInfo)->
+ create_etag(FileInfo#file_info.mtime,FileInfo#file_info.size).
+
+create_etag({{Year,Month,Day},{Hour,Min,Sec}},Size)->
+ create_part([Year,Month,Day,Hour,Min,Sec])++io_lib:write(Size);
+
+create_etag(FileInfo,Size)->
+ create_etag(FileInfo#file_info.mtime,Size).
+
+create_part(Values)->
+ lists:map(fun(Val0)->
+ Val=Val0 rem 60,
+ if
+ Val=<25 ->
+ 65+Val; % A-Z
+ Val=<50 ->
+ 72+Val; % a-z
+ %%Since no date s
+ true ->
+ Val-3
+ end
+ end,Values).
+
+
+
+%%----------------------------------------------------------------------
+%%Function that controls whether a response is generated or not
+%%----------------------------------------------------------------------
+response_generated(Info)->
+ case httpd_util:key1search(Info#mod.data,status) of
+ %% A status code has been generated!
+ {StatusCode,PhraseArgs,Reason}->
+ true;
+ %%No status code control repsonsxe
+ undefined ->
+ case httpd_util:key1search(Info#mod.data, response) of
+ %% No response has been generated!
+ undefined ->
+ false;
+ %% A response has been generated or sent!
+ Response ->
+ true
+ end
+ end.
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.erl
new file mode 100644
index 0000000000..c772a11dd1
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.erl
@@ -0,0 +1,94 @@
+%% ``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: httpd_verbosity.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(httpd_verbosity).
+
+-include_lib("stdlib/include/erl_compile.hrl").
+
+-export([print/4,print/5,printc/4,validate/1]).
+
+print(silence,_Severity,_Format,_Arguments) ->
+ ok;
+print(Verbosity,Severity,Format,Arguments) ->
+ print1(printable(Verbosity,Severity),Format,Arguments).
+
+
+print(silence,_Severity,_Module,_Format,_Arguments) ->
+ ok;
+print(Verbosity,Severity,Module,Format,Arguments) ->
+ print1(printable(Verbosity,Severity),Module,Format,Arguments).
+
+
+printc(silence,Severity,Format,Arguments) ->
+ ok;
+printc(Verbosity,Severity,Format,Arguments) ->
+ print2(printable(Verbosity,Severity),Format,Arguments).
+
+
+print1(false,_Format,_Arguments) -> ok;
+print1(Verbosity,Format,Arguments) ->
+ V = image_of_verbosity(Verbosity),
+ S = image_of_sname(get(sname)),
+ io:format("** HTTPD ~s ~s: " ++ Format ++ "~n",[S,V]++Arguments).
+
+print1(false,_Module,_Format,_Arguments) -> ok;
+print1(Verbosity,Module,Format,Arguments) ->
+ V = image_of_verbosity(Verbosity),
+ S = image_of_sname(get(sname)),
+ io:format("** HTTPD ~s ~s ~s: " ++ Format ++ "~n",[S,Module,V]++Arguments).
+
+
+print2(false,_Format,_Arguments) -> ok;
+print2(_Verbosity,Format,Arguments) ->
+ io:format(Format ++ "~n",Arguments).
+
+
+%% printable(Verbosity,Severity)
+printable(info,info) -> info;
+printable(log,info) -> info;
+printable(log,log) -> log;
+printable(debug,info) -> info;
+printable(debug,log) -> log;
+printable(debug,debug) -> debug;
+printable(trace,V) -> V;
+printable(_Verb,_Sev) -> false.
+
+
+image_of_verbosity(info) -> "INFO";
+image_of_verbosity(log) -> "LOG";
+image_of_verbosity(debug) -> "DEBUG";
+image_of_verbosity(trace) -> "TRACE";
+image_of_verbosity(_) -> "".
+
+%% ShortName
+image_of_sname(acc) -> "ACCEPTOR";
+image_of_sname(acc_sup) -> "ACCEPTOR_SUP";
+image_of_sname(auth) -> "AUTH";
+image_of_sname(man) -> "MANAGER";
+image_of_sname(misc_sup) -> "MISC_SUP";
+image_of_sname(sec) -> "SECURITY";
+image_of_sname(P) when pid(P) -> io_lib:format("REQUEST_HANDLER(~p)",[P]);
+image_of_sname(undefined) -> "";
+image_of_sname(V) -> io_lib:format("~p",[V]).
+
+
+validate(info) -> info;
+validate(log) -> log;
+validate(debug) -> debug;
+validate(trace) -> trace;
+validate(_) -> silence.
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.hrl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.hrl
new file mode 100644
index 0000000000..caafd8ef18
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.hrl
@@ -0,0 +1,65 @@
+%% ``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: httpd_verbosity.hrl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+
+-ifndef(dont_use_verbosity).
+
+-ifndef(default_verbosity).
+-define(default_verbosity,silence).
+-endif.
+
+-define(vvalidate(V), httpd_verbosity:validate(V)).
+
+-ifdef(VMODULE).
+
+-define(vinfo(F,A), httpd_verbosity:print(get(verbosity),info, ?VMODULE,F,A)).
+-define(vlog(F,A), httpd_verbosity:print(get(verbosity),log, ?VMODULE,F,A)).
+-define(vdebug(F,A),httpd_verbosity:print(get(verbosity),debug,?VMODULE,F,A)).
+-define(vtrace(F,A),httpd_verbosity:print(get(verbosity),trace,?VMODULE,F,A)).
+
+-else.
+
+-define(vinfo(F,A), httpd_verbosity:print(get(verbosity),info, F,A)).
+-define(vlog(F,A), httpd_verbosity:print(get(verbosity),log, F,A)).
+-define(vdebug(F,A),httpd_verbosity:print(get(verbosity),debug,F,A)).
+-define(vtrace(F,A),httpd_verbosity:print(get(verbosity),trace,F,A)).
+
+-endif.
+
+-define(vinfoc(F,A), httpd_verbosity:printc(get(verbosity),info, F,A)).
+-define(vlogc(F,A), httpd_verbosity:printc(get(verbosity),log, F,A)).
+-define(vdebugc(F,A),httpd_verbosity:printc(get(verbosity),debug,F,A)).
+-define(vtracec(F,A),httpd_verbosity:printc(get(verbosity),trace,F,A)).
+
+-else.
+
+-define(vvalidate(V),ok).
+
+-define(vinfo(F,A),ok).
+-define(vlog(F,A),ok).
+-define(vdebug(F,A),ok).
+-define(vtrace(F,A),ok).
+
+-define(vinfoc(F,A),ok).
+-define(vlogc(F,A),ok).
+-define(vdebugc(F,A),ok).
+-define(vtracec(F,A),ok).
+
+-endif.
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.app.src b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.app.src
new file mode 100644
index 0000000000..1bf5fcc56e
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.app.src
@@ -0,0 +1,56 @@
+{application,inets,
+ [{description,"INETS CXC 138 49"},
+ {vsn,"%VSN%"},
+ {modules,[
+ %% FTP
+ ftp,
+
+ %% HTTP client:
+ http,
+ http_lib,
+ httpc_handler,
+ httpc_manager,
+ uri,
+
+ %% HTTP server:
+ httpd,
+ httpd_acceptor,
+ httpd_acceptor_sup,
+ httpd_conf,
+ httpd_example,
+ httpd_manager,
+ httpd_misc_sup,
+ httpd_parse,
+ httpd_request_handler,
+ httpd_response,
+ httpd_socket,
+ httpd_sup,
+ httpd_util,
+ httpd_verbosity,
+ inets_sup,
+ mod_actions,
+ mod_alias,
+ mod_auth,
+ mod_auth_dets,
+ mod_auth_mnesia,
+ mod_auth_plain,
+ mod_auth_server,
+ mod_browser,
+ mod_cgi,
+ mod_dir,
+ mod_disk_log,
+ mod_esi,
+ mod_get,
+ mod_head,
+ mod_htaccess,
+ mod_include,
+ mod_log,
+ mod_range,
+ mod_responsecontrol,
+ mod_security,
+ mod_security_server,
+ mod_trace
+ ]},
+ {registered,[inets_sup]},
+ {applications,[kernel,stdlib]},
+ {mod,{inets_sup,[]}}]}.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.appup.src b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.appup.src
new file mode 100644
index 0000000000..f612dc5b91
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.appup.src
@@ -0,0 +1,135 @@
+{"%VSN%",
+ [{"3.0.5",
+ [
+ {load_module, ftp, soft_purge, soft_purge, []}
+ ]
+ },
+ {"3.0.4",
+ [
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []}
+ ]
+ },
+ {"3.0.3",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge, [mod_disk_log]},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []},
+ {update, httpd_sup, soft, soft_purge, soft_purge, [httpd_manager]},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [mod_disk_log, httpd_conf, httpd_socket]}]
+ },
+ {"3.0.2",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge, [mod_disk_log]},
+ {update, httpd_sup, soft, soft_purge, soft_purge, [httpd_manager]},
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [httpd_request_handler, httpd_conf, httpd_socket]},
+ {update, httpd_request_handler, soft, soft_purge, soft_purge,
+ [httpd_response]}]
+ },
+ {"3.0.1",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge,
+ [mod_auth, mod_disk_log]},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {load_module, mod_auth, soft_purge, soft_purge, []},
+ {update, httpd_sup, soft, soft_purge, soft_purge, [httpd_manager]},
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [httpd_request_handler, httpd_conf, httpd_socket]},
+ {update, httpd_request_handler, soft, soft_purge, soft_purge,
+ [httpd_response]}]
+ },
+ {"3.0",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge,
+ [mod_auth, mod_disk_log]},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {load_module, mod_auth, soft_purge, soft_purge, []},
+ {update, httpd_sup, soft, soft_purge, soft_purge,
+ [httpd_manager, httpd_misc_sup]},
+ {update, httpd_misc_sup, soft, soft_purge, soft_purge, []},
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [httpd_request_handler, httpd_conf, httpd_socket]},
+ {update, httpd_request_handler, soft, soft_purge, soft_purge,
+ [httpd_response]}]
+ }
+ ],
+ [{"3.0.5",
+ [
+ {load_module, ftp, soft_purge, soft_purge, []}
+ ]
+ },
+ {"3.0.4",
+ [{update, httpd_acceptor, soft, soft_purge, soft_purge, []}]
+ },
+ {"3.0.3",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge, [mod_disk_log]},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {update, httpd_sup, soft, soft_purge, soft_purge, [httpd_manager]},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [mod_disk_log, httpd_conf, httpd_socket]}]
+ },
+ {"3.0.2",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge, [mod_disk_log]},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {update, httpd_sup, soft, soft_purge, soft_purge, [httpd_manager]},
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [httpd_request_handler, httpd_conf, httpd_socket]},
+ {update, httpd_request_handler, soft, soft_purge, soft_purge,
+ [httpd_response]}]
+ },
+ {"3.0.1",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge,
+ [mod_auth, mod_disk_log]},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {load_module, mod_auth, soft_purge, soft_purge, []},
+ {update, httpd_sup, soft, soft_purge, soft_purge, [httpd_manager]},
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [httpd_request_handler, httpd_conf, httpd_socket]},
+ {update, httpd_request_handler, soft, soft_purge, soft_purge,
+ [httpd_response]}]
+ },
+ {"3.0",
+ [{load_module, httpd, soft_purge, soft_purge, [httpd_conf, httpd_sup]},
+ {load_module, httpd_conf, soft_purge, soft_purge, []},
+ {load_module, httpd_socket, soft_purge, soft_purge, []},
+ {load_module, httpd_response, soft_purge, soft_purge,
+ [mod_auth, mod_disk_log]},
+ {load_module, mod_disk_log, soft_purge, soft_purge, []},
+ {load_module, mod_auth, soft_purge, soft_purge, []},
+ {update, httpd_sup, soft, soft_purge, soft_purge,
+ [httpd_manager, httpd_misc_sup]},
+ {update, httpd_misc_sup, soft, soft_purge, soft_purge, []},
+ {update, httpd_acceptor, soft, soft_purge, soft_purge, []},
+ {update, httpd_manager, soft, soft_purge, soft_purge,
+ [httpd_request_handler, httpd_conf, httpd_socket]},
+ {update, httpd_request_handler, soft, soft_purge, soft_purge,
+ [httpd_response]}]
+ }
+ ]
+}.
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.config b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.config
new file mode 100644
index 0000000000..adf0e3ecf1
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.config
@@ -0,0 +1,2 @@
+[{inets,[{services,[{httpd,"/var/tmp/server_root/conf/8888.conf"},
+ {httpd,"/var/tmp/server_root/conf/8080.conf"}]}]}].
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets_sup.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets_sup.erl
new file mode 100644
index 0000000000..6bda87148c
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets_sup.erl
@@ -0,0 +1,158 @@
+%% ``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: inets_sup.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(inets_sup).
+
+-export([crock/0]).
+-export([start/2, stop/1, init/1]).
+-export([start_child/2, stop_child/2, which_children/0]).
+
+
+%% crock (Used for debugging!)
+
+crock() ->
+ application:start(sasl),
+ application:start(inets).
+
+
+%% start
+
+start(Type, State) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+
+%% stop
+
+stop(State) ->
+ ok.
+
+
+%% start_child
+
+start_child(ConfigFile, Verbosity) ->
+ {ok, Spec} = httpd_child_spec(ConfigFile, Verbosity),
+ supervisor:start_child(?MODULE, Spec).
+
+
+%% stop_child
+
+stop_child(Addr, Port) ->
+ Name = {httpd_sup, Addr, Port},
+ case supervisor:terminate_child(?MODULE, Name) of
+ ok ->
+ supervisor:delete_child(?MODULE, Name);
+ Error ->
+ Error
+ end.
+
+
+%% which_children
+
+which_children() ->
+ supervisor:which_children(?MODULE).
+
+
+%% init
+
+init([]) ->
+ case get_services() of
+ {error, Reason} ->
+ {error,Reason};
+ Services ->
+ SupFlags = {one_for_one, 10, 3600},
+ {ok, {SupFlags, child_spec(Services, [])}}
+ end.
+
+get_services() ->
+ case (catch application:get_env(inets, services)) of
+ {ok, Services} ->
+ Services;
+ _ ->
+ []
+ end.
+
+
+child_spec([], Acc) ->
+ Acc;
+child_spec([{httpd, ConfigFile, Verbosity}|Rest], Acc) ->
+ case httpd_child_spec(ConfigFile, Verbosity) of
+ {ok, Spec} ->
+ child_spec(Rest, [Spec | Acc]);
+ {error, Reason} ->
+ error_msg("Failed creating child spec "
+ "using ~p for reason: ~p", [ConfigFile, Reason]),
+ child_spec(Rest, Acc)
+ end;
+child_spec([{httpd, ConfigFile}|Rest], Acc) ->
+ case httpd_child_spec(ConfigFile, []) of
+ {ok, Spec} ->
+ child_spec(Rest, [Spec | Acc]);
+ {error, Reason} ->
+ error_msg("Failed creating child spec "
+ "using ~p for reason: ~p", [ConfigFile, Reason]),
+ child_spec(Rest, Acc)
+ end.
+
+
+httpd_child_spec(ConfigFile, Verbosity) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ Port = httpd_util:key1search(ConfigList, port, 80),
+ Addr = httpd_util:key1search(ConfigList, bind_address),
+ {ok, httpd_child_spec(ConfigFile, Addr, Port, Verbosity)};
+ Error ->
+ Error
+ end.
+
+
+httpd_child_spec(ConfigFile, Addr, Port, Verbosity) ->
+ {{httpd_sup, Addr, Port},{httpd_sup, start_link,[ConfigFile, Verbosity]},
+ permanent, 20000, supervisor,
+ [ftp,
+ httpd,
+ httpd_conf,
+ httpd_example,
+ httpd_manager,
+ httpd_misc_sup,
+ httpd_listener,
+ httpd_parse,
+ httpd_request,
+ httpd_response,
+ httpd_socket,
+ httpd_sup,
+ httpd_util,
+ httpd_verbosity,
+ inets_sup,
+ mod_actions,
+ mod_alias,
+ mod_auth,
+ mod_cgi,
+ mod_dir,
+ mod_disk_log,
+ mod_esi,
+ mod_get,
+ mod_head,
+ mod_include,
+ mod_log,
+ mod_auth_mnesia,
+ mod_auth_plain,
+ mod_auth_dets,
+ mod_security]}.
+
+
+error_msg(F, A) ->
+ error_logger:error_msg(F ++ "~n", A).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/jnets_httpd.hrl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/jnets_httpd.hrl
new file mode 100644
index 0000000000..721a6b991d
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/jnets_httpd.hrl
@@ -0,0 +1,138 @@
+%% ``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 Mobile Arts AB
+%% Portions created by Mobile Arts are Copyright 2002, Mobile Arts AB
+%% All Rights Reserved.''
+%%
+%%
+
+-include_lib("kernel/include/file.hrl").
+
+-define(SOCKET_CHUNK_SIZE,8192).
+-define(SOCKET_MAX_POLL,25).
+-define(FILE_CHUNK_SIZE,64*1024).
+-define(NICE(Reason),lists:flatten(atom_to_list(?MODULE)++": "++Reason)).
+-define(DEFAULT_CONTEXT,
+ [{errmsg,"[an error occurred while processing this directive]"},
+ {timefmt,"%A, %d-%b-%y %T %Z"},
+ {sizefmt,"abbrev"}]).
+
+
+-ifdef(inets_debug).
+-define(DEBUG(Format, Args), io:format("D(~p:~p:~p) : "++Format++"~n",
+ [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(DEBUG(F,A),[]).
+-endif.
+
+-define(MAXBODYSIZE,16#ffffffff).
+
+-define(HTTP_VERSION_10,0).
+-define(HTTP_VERSION_11,1).
+
+-define(CR,13).
+-define(LF,10).
+
+
+-record(init_data,{peername,resolve}).
+
+
+-record(mod,{
+ init_data, %
+ data= [], % list() Used to propagate data between modules
+ socket_type=ip_comm, % socket_type() IP or SSL socket
+ socket, % socket() Actual socket
+ config_db, % ets() {key,val} db with config entries
+ method, % atom() HTTP method, e.g. 'GET'
+% request_uri, % string() Request URI
+ path, % string() Absolute path. May include query etc
+ http_version, % int() HTTP minor version number, e.g. 0 or 1
+% request_line, % string() Request Line
+ headers, % #req_headers{} Parsed request headers
+ entity_body= <<>>, % binary() Body of request
+ connection, % boolean() true if persistant connection
+ status_code, % int() Status code
+ logging % int() 0=No logging
+ % 1=Only mod_log present
+ % 2=Only mod_disk_log present
+ % 3=Both mod_log and mod_disk_log present
+ }).
+
+% -record(ssl,{
+% certfile, %
+% keyfile, %
+% verify= 0, %
+% ciphers, %
+% password, %
+% depth = 1, %
+% cacertfile, %
+
+% cachetimeout % Found in yaws....
+% }).
+
+
+-record(http_request,{
+ method, % atom() if known else string() HTTP methd
+ path, % {abs_path,string()} URL path
+ version % {int(),int()} {Major,Minor} HTTP version
+ }).
+
+-record(http_response,{
+ version, % {int(),int()} {Major,Minor} HTTP version
+ status, % int() Status code
+ phrase % string() HTTP Reason phrase
+ }).
+
+
+%%% Request headers
+-record(req_headers,{
+%%% --- Standard "General" headers
+% cache_control,
+ connection="keep-alive",
+% date,
+% pragma,
+% trailer,
+ transfer_encoding,
+% upgrade,
+% via,
+% warning,
+%%% --- Standard "Request" headers
+% accept,
+% accept_charset,
+% accept_encoding,
+% accept_language,
+ authorization,
+ expect, %% FIXME! Update inet_drv.c!!
+% from,
+ host,
+ if_match,
+ if_modified_since,
+ if_none_match,
+ if_range,
+ if_unmodified_since,
+% max_forwards,
+% proxy_authorization,
+ range,
+% referer,
+% te, %% FIXME! Update inet_drv.c!!
+ user_agent,
+%%% --- Standard "Entity" headers
+% content_encoding,
+% content_language,
+ content_length="0",
+% content_location,
+% content_md5,
+% content_range,
+ content_type,
+% last_modified,
+ other=[] % (list) Key/Value list with other headers
+ }).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_actions.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_actions.erl
new file mode 100644
index 0000000000..93bdb9fb40
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_actions.erl
@@ -0,0 +1,92 @@
+%% ``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_actions.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(mod_actions).
+-export([do/1,load/2]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ Path=mod_alias:path(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri),
+ Suffix=httpd_util:suffix(Path),
+ MimeType=httpd_util:lookup_mime(Info#mod.config_db,Suffix,
+ "text/plain"),
+ Actions=httpd_util:multi_lookup(Info#mod.config_db,action),
+ case action(Info#mod.request_uri,MimeType,Actions) of
+ {yes,RequestURI} ->
+ {proceed,[{new_request_uri,RequestURI}|Info#mod.data]};
+ no ->
+ Scripts=httpd_util:multi_lookup(Info#mod.config_db,script),
+ case script(Info#mod.request_uri,Info#mod.method,Scripts) of
+ {yes,RequestURI} ->
+ {proceed,[{new_request_uri,RequestURI}|Info#mod.data]};
+ no ->
+ {proceed,Info#mod.data}
+ end
+ end;
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end.
+
+action(RequestURI,MimeType,[]) ->
+ no;
+action(RequestURI,MimeType,[{MimeType,CGIScript}|Rest]) ->
+ {yes,CGIScript++RequestURI};
+action(RequestURI,MimeType,[_|Rest]) ->
+ action(RequestURI,MimeType,Rest).
+
+script(RequestURI,Method,[]) ->
+ no;
+script(RequestURI,Method,[{Method,CGIScript}|Rest]) ->
+ {yes,CGIScript++RequestURI};
+script(RequestURI,Method,[_|Rest]) ->
+ script(RequestURI,Method,Rest).
+
+%%
+%% Configuration
+%%
+
+%% load
+
+load([$A,$c,$t,$i,$o,$n,$ |Action],[]) ->
+ case regexp:split(Action," ") of
+ {ok,[MimeType,CGIScript]} ->
+ {ok,[],{action,{MimeType,CGIScript}}};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Action)++" is an invalid Action")}
+ end;
+load([$S,$c,$r,$i,$p,$t,$ |Script],[]) ->
+ case regexp:split(Script," ") of
+ {ok,[Method,CGIScript]} ->
+ {ok,[],{script,{Method,CGIScript}}};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Script)++" is an invalid Script")}
+ end.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_alias.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_alias.erl
new file mode 100644
index 0000000000..e01c18b3d6
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_alias.erl
@@ -0,0 +1,175 @@
+%% ``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_alias.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(mod_alias).
+-export([do/1,real_name/3,real_script_name/3,default_index/2,load/2,path/3]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ do_alias(Info);
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end.
+
+do_alias(Info) ->
+ ?DEBUG("do_alias -> Request URI: ~p",[Info#mod.request_uri]),
+ {ShortPath,Path,AfterPath} =
+ real_name(Info#mod.config_db,Info#mod.request_uri,
+ httpd_util:multi_lookup(Info#mod.config_db,alias)),
+ %% Relocate if a trailing slash is missing else proceed!
+ LastChar = lists:last(ShortPath),
+ case file:read_file_info(ShortPath) of
+ {ok,FileInfo} when FileInfo#file_info.type == directory,LastChar /= $/ ->
+ ?LOG("do_alias -> ~n"
+ " ShortPath: ~p~n"
+ " LastChar: ~p~n"
+ " FileInfo: ~p",
+ [ShortPath,LastChar,FileInfo]),
+ ServerName = httpd_util:lookup(Info#mod.config_db,server_name),
+ Port = port_string(httpd_util:lookup(Info#mod.config_db,port,80)),
+ URL = "http://"++ServerName++Port++Info#mod.request_uri++"/",
+ ReasonPhrase = httpd_util:reason_phrase(301),
+ Message = httpd_util:message(301,URL,Info#mod.config_db),
+ {proceed,
+ [{response,
+ {301, ["Location: ", URL, "\r\n"
+ "Content-Type: text/html\r\n",
+ "\r\n",
+ "<HTML>\n<HEAD>\n<TITLE>",ReasonPhrase,
+ "</TITLE>\n</HEAD>\n"
+ "<BODY>\n<H1>",ReasonPhrase,
+ "</H1>\n", Message,
+ "\n</BODY>\n</HTML>\n"]}}|
+ [{real_name,{Path,AfterPath}}|Info#mod.data]]};
+ NoFile ->
+ {proceed,[{real_name,{Path,AfterPath}}|Info#mod.data]}
+ end.
+
+port_string(80) ->
+ "";
+port_string(Port) ->
+ ":"++integer_to_list(Port).
+
+%% real_name
+
+real_name(ConfigDB, RequestURI,[]) ->
+ DocumentRoot = httpd_util:lookup(ConfigDB, document_root, ""),
+ RealName = DocumentRoot++RequestURI,
+ {ShortPath, _AfterPath} = httpd_util:split_path(RealName),
+ {Path, AfterPath}=httpd_util:split_path(default_index(ConfigDB,RealName)),
+ {ShortPath, Path, AfterPath};
+real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) ->
+ case regexp:match(RequestURI, "^"++FakeName) of
+ {match, _, _} ->
+ {ok, ActualName, _} = regexp:sub(RequestURI,
+ "^"++FakeName, RealName),
+ {ShortPath, _AfterPath} = httpd_util:split_path(ActualName),
+ {Path, AfterPath} =
+ httpd_util:split_path(default_index(ConfigDB, ActualName)),
+ {ShortPath, Path, AfterPath};
+ nomatch ->
+ real_name(ConfigDB,RequestURI,Rest)
+ end.
+
+%% real_script_name
+
+real_script_name(ConfigDB,RequestURI,[]) ->
+ not_a_script;
+real_script_name(ConfigDB,RequestURI,[{FakeName,RealName}|Rest]) ->
+ case regexp:match(RequestURI,"^"++FakeName) of
+ {match,_,_} ->
+ {ok,ActualName,_}=regexp:sub(RequestURI,"^"++FakeName,RealName),
+ httpd_util:split_script_path(default_index(ConfigDB,ActualName));
+ nomatch ->
+ real_script_name(ConfigDB,RequestURI,Rest)
+ end.
+
+%% default_index
+
+default_index(ConfigDB, Path) ->
+ case file:read_file_info(Path) of
+ {ok, FileInfo} when FileInfo#file_info.type == directory ->
+ DirectoryIndex = httpd_util:lookup(ConfigDB, directory_index, []),
+ append_index(Path, DirectoryIndex);
+ _ ->
+ Path
+ end.
+
+append_index(RealName, []) ->
+ RealName;
+append_index(RealName, [Index|Rest]) ->
+ case file:read_file_info(filename:join(RealName, Index)) of
+ {error,Reason} ->
+ append_index(RealName, Rest);
+ _ ->
+ filename:join(RealName,Index)
+ end.
+
+%% path
+
+path(Data, ConfigDB, RequestURI) ->
+ case httpd_util:key1search(Data,real_name) of
+ undefined ->
+ DocumentRoot = httpd_util:lookup(ConfigDB, document_root, ""),
+ {Path,AfterPath} =
+ httpd_util:split_path(DocumentRoot++RequestURI),
+ Path;
+ {Path,AfterPath} ->
+ Path
+ end.
+
+%%
+%% Configuration
+%%
+
+%% load
+
+load([$D,$i,$r,$e,$c,$t,$o,$r,$y,$I,$n,$d,$e,$x,$ |DirectoryIndex],[]) ->
+ {ok, DirectoryIndexes} = regexp:split(DirectoryIndex," "),
+ {ok,[], {directory_index, DirectoryIndexes}};
+load([$A,$l,$i,$a,$s,$ |Alias],[]) ->
+ case regexp:split(Alias," ") of
+ {ok, [FakeName, RealName]} ->
+ {ok,[],{alias,{FakeName,RealName}}};
+ {ok, _} ->
+ {error,?NICE(httpd_conf:clean(Alias)++" is an invalid Alias")}
+ end;
+load([$S,$c,$r,$i,$p,$t,$A,$l,$i,$a,$s,$ |ScriptAlias],[]) ->
+ case regexp:split(ScriptAlias," ") of
+ {ok, [FakeName, RealName]} ->
+ %% Make sure the path always has a trailing slash..
+ RealName1 = filename:join(filename:split(RealName)),
+ {ok, [], {script_alias,{FakeName, RealName1++"/"}}};
+ {ok, _} ->
+ {error, ?NICE(httpd_conf:clean(ScriptAlias)++
+ " is an invalid ScriptAlias")}
+ end.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.erl
new file mode 100644
index 0000000000..dadb64e3c1
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.erl
@@ -0,0 +1,750 @@
+%% ``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_auth.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+-module(mod_auth).
+
+
+%% The functions that the webbserver call on startup stop
+%% and when the server traverse the modules.
+-export([do/1, load/2, store/2, remove/1]).
+
+%% User entries to the gen-server.
+-export([add_user/2, add_user/5, add_user/6,
+ add_group_member/3, add_group_member/4, add_group_member/5,
+ list_users/1, list_users/2, list_users/3,
+ delete_user/2, delete_user/3, delete_user/4,
+ delete_group_member/3, delete_group_member/4, delete_group_member/5,
+ list_groups/1, list_groups/2, list_groups/3,
+ delete_group/2, delete_group/3, delete_group/4,
+ get_user/2, get_user/3, get_user/4,
+ list_group_members/2, list_group_members/3, list_group_members/4,
+ update_password/6, update_password/5]).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+-define(VMODULE,"AUTH").
+-include("httpd_verbosity.hrl").
+
+-define(NOPASSWORD,"NoPassword").
+
+
+%% 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ Path = mod_alias:path(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri),
+ %% Is it a secret area?
+ case secretp(Path,Info#mod.config_db) of
+ {yes, Directory, DirectoryData} ->
+ %% Authenticate (allow)
+ case allow((Info#mod.init_data)#init_data.peername,
+ Info#mod.socket_type,Info#mod.socket,
+ DirectoryData) of
+ allowed ->
+ case deny((Info#mod.init_data)#init_data.peername,
+ Info#mod.socket_type, Info#mod.socket,
+ DirectoryData) of
+ not_denied ->
+ case httpd_util:key1search(DirectoryData,
+ auth_type) of
+ undefined ->
+ {proceed, Info#mod.data};
+ none ->
+ {proceed, Info#mod.data};
+ AuthType ->
+ do_auth(Info,
+ Directory,
+ DirectoryData,
+ AuthType)
+ end;
+ {denied, Reason} ->
+ {proceed,
+ [{status,{403,Info#mod.request_uri,Reason}}|
+ Info#mod.data]}
+ end;
+ {not_allowed, Reason} ->
+ {proceed,[{status,{403,Info#mod.request_uri,Reason}}|
+ Info#mod.data]}
+ end;
+ no ->
+ {proceed, Info#mod.data}
+ end;
+ %% A response has been generated or sent!
+ Response ->
+ {proceed, Info#mod.data}
+ end
+ end.
+
+
+do_auth(Info, Directory, DirectoryData, AuthType) ->
+ %% Authenticate (require)
+ case require(Info, Directory, DirectoryData) of
+ authorized ->
+ {proceed,Info#mod.data};
+ {authorized, User} ->
+ {proceed, [{remote_user,User}|Info#mod.data]};
+ {authorization_failed, Reason} ->
+ ?vtrace("do_auth -> authorization_failed: ~p",[Reason]),
+ {proceed, [{status,{401,none,Reason}}|Info#mod.data]};
+ {authorization_required, Realm} ->
+ ?vtrace("do_auth -> authorization_required: ~p",[Realm]),
+ ReasonPhrase = httpd_util:reason_phrase(401),
+ Message = httpd_util:message(401,none,Info#mod.config_db),
+ {proceed,
+ [{response,
+ {401,
+ ["WWW-Authenticate: Basic realm=\"",Realm,
+ "\"\r\n\r\n","<HTML>\n<HEAD>\n<TITLE>",
+ ReasonPhrase,"</TITLE>\n",
+ "</HEAD>\n<BODY>\n<H1>",ReasonPhrase,
+ "</H1>\n",Message,"\n</BODY>\n</HTML>\n"]}}|
+ Info#mod.data]};
+ {status, {StatusCode,PhraseArgs,Reason}} ->
+ {proceed, [{status,{StatusCode,PhraseArgs,Reason}}|
+ Info#mod.data]}
+ end.
+
+
+%% require
+
+require(Info, Directory, DirectoryData) ->
+ ParsedHeader = Info#mod.parsed_header,
+ ValidUsers = httpd_util:key1search(DirectoryData, require_user),
+ ValidGroups = httpd_util:key1search(DirectoryData, require_group),
+
+ %% Any user or group restrictions?
+ case ValidGroups of
+ undefined when ValidUsers == undefined ->
+ authorized;
+ _ ->
+ case httpd_util:key1search(ParsedHeader, "authorization") of
+ %% Authorization required!
+ undefined ->
+ case httpd_util:key1search(DirectoryData, auth_name) of
+ undefined ->
+ {status,{500,none,?NICE("AuthName directive not specified")}};
+ Realm ->
+ {authorization_required, Realm}
+ end;
+ %% Check credentials!
+ [$B,$a,$s,$i,$c,$ | EncodedString] ->
+ DecodedString = httpd_util:decode_base64(EncodedString),
+ case a_valid_user(Info, DecodedString,
+ ValidUsers, ValidGroups,
+ Directory, DirectoryData) of
+ {yes, User} ->
+ {authorized, User};
+ {no, Reason} ->
+ {authorization_failed, Reason};
+ {status, {StatusCode,PhraseArgs,Reason}} ->
+ {status,{StatusCode,PhraseArgs,Reason}}
+ end;
+ %% Bad credentials!
+ BadCredentials ->
+ {status,{401,none,?NICE("Bad credentials "++BadCredentials)}}
+ end
+ end.
+
+a_valid_user(Info,DecodedString,ValidUsers,ValidGroups,Dir,DirData) ->
+ case httpd_util:split(DecodedString,":",2) of
+ {ok,[SupposedUser, Password]} ->
+ case user_accepted(SupposedUser, ValidUsers) of
+ true ->
+ check_password(SupposedUser, Password, Dir, DirData);
+ false ->
+ case group_accepted(Info,SupposedUser,ValidGroups,Dir,DirData) of
+ true ->
+ check_password(SupposedUser,Password,Dir,DirData);
+ false ->
+ {no,?NICE("No such user exists")}
+ end
+ end;
+ {ok,BadCredentials} ->
+ {status,{401,none,?NICE("Bad credentials "++BadCredentials)}}
+ end.
+
+user_accepted(SupposedUser, undefined) ->
+ false;
+user_accepted(SupposedUser, ValidUsers) ->
+ lists:member(SupposedUser, ValidUsers).
+
+
+group_accepted(Info, User, undefined, Dir, DirData) ->
+ false;
+group_accepted(Info, User, [], Dir, DirData) ->
+ false;
+group_accepted(Info, User, [Group|Rest], Dir, DirData) ->
+ Ret = int_list_group_members(Group, Dir, DirData),
+ case Ret of
+ {ok, UserList} ->
+ case lists:member(User, UserList) of
+ true ->
+ true;
+ false ->
+ group_accepted(Info, User, Rest, Dir, DirData)
+ end;
+ Other ->
+ false
+ end.
+
+check_password(User, Password, Dir, DirData) ->
+ case int_get_user(DirData, User) of
+ {ok, UStruct} ->
+ case UStruct#httpd_user.password of
+ Password ->
+ %% FIXME
+ {yes, UStruct#httpd_user.username};
+ Other ->
+ {no, "No such user"} % Don't say 'Bad Password' !!!
+ end;
+ _ ->
+ {no, "No such user"}
+ end.
+
+
+%% Middle API. Theese functions call the appropriate authentication module.
+int_get_user(DirData, User) ->
+ AuthMod = auth_mod_name(DirData),
+ apply(AuthMod, get_user, [DirData, User]).
+
+int_list_group_members(Group, Dir, DirData) ->
+ AuthMod = auth_mod_name(DirData),
+ apply(AuthMod, list_group_members, [DirData, Group]).
+
+auth_mod_name(DirData) ->
+ case httpd_util:key1search(DirData, auth_type, plain) of
+ plain -> mod_auth_plain;
+ mnesia -> mod_auth_mnesia;
+ dets -> mod_auth_dets
+ end.
+
+
+%%
+%% Is it a secret area?
+%%
+
+%% secretp
+
+secretp(Path,ConfigDB) ->
+ Directories = ets:match(ConfigDB,{directory,'$1','_'}),
+ case secret_path(Path, Directories) of
+ {yes,Directory} ->
+ {yes,Directory,
+ lists:flatten(ets:match(ConfigDB,{directory,Directory,'$1'}))};
+ no ->
+ no
+ end.
+
+secret_path(Path,Directories) ->
+ secret_path(Path, httpd_util:uniq(lists:sort(Directories)),to_be_found).
+
+secret_path(Path,[],to_be_found) ->
+ no;
+secret_path(Path,[],Directory) ->
+ {yes,Directory};
+secret_path(Path,[[NewDirectory]|Rest],Directory) ->
+ case regexp:match(Path,NewDirectory) of
+ {match,_,_} when Directory == to_be_found ->
+ secret_path(Path,Rest,NewDirectory);
+ {match,_,Length} when Length > length(Directory)->
+ secret_path(Path,Rest,NewDirectory);
+ {match,_,Length} ->
+ secret_path(Path,Rest,Directory);
+ nomatch ->
+ secret_path(Path,Rest,Directory)
+ end.
+
+%%
+%% Authenticate
+%%
+
+%% allow
+
+allow({_,RemoteAddr},SocketType,Socket,DirectoryData) ->
+ Hosts = httpd_util:key1search(DirectoryData, allow_from, all),
+ case validate_addr(RemoteAddr,Hosts) of
+ true ->
+ allowed;
+ false ->
+ {not_allowed, ?NICE("Connection from your host is not allowed")}
+ end.
+
+validate_addr(RemoteAddr,all) -> % When called from 'allow'
+ true;
+validate_addr(RemoteAddr,none) -> % When called from 'deny'
+ false;
+validate_addr(RemoteAddr,[]) ->
+ false;
+validate_addr(RemoteAddr,[HostRegExp|Rest]) ->
+ ?DEBUG("validate_addr -> RemoteAddr: ~p HostRegExp: ~p",
+ [RemoteAddr, HostRegExp]),
+ case regexp:match(RemoteAddr, HostRegExp) of
+ {match,_,_} ->
+ true;
+ nomatch ->
+ validate_addr(RemoteAddr,Rest)
+ end.
+
+%% deny
+
+deny({_,RemoteAddr},SocketType,Socket,DirectoryData) ->
+ ?DEBUG("deny -> RemoteAddr: ~p",[RemoteAddr]),
+ Hosts = httpd_util:key1search(DirectoryData, deny_from, none),
+ ?DEBUG("deny -> Hosts: ~p",[Hosts]),
+ case validate_addr(RemoteAddr,Hosts) of
+ true ->
+ {denied, ?NICE("Connection from your host is not allowed")};
+ false ->
+ not_denied
+ end.
+
+%%
+%% Configuration
+%%
+
+%% load/2
+%%
+
+%% mod_auth recognizes the following Configuration Directives:
+%% <Directory /path/to/directory>
+%% AuthDBType
+%% AuthName
+%% AuthUserFile
+%% AuthGroupFile
+%% AuthAccessPassword
+%% require
+%% allow
+%% </Directory>
+
+%% When a <Directory> directive is found, a new context is set to
+%% [{directory, Directory, DirData}|OtherContext]
+%% DirData in this case is a key-value list of data belonging to the
+%% directory in question.
+%%
+%% When the </Directory> statement is found, the Context created earlier
+%% will be returned as a ConfigList and the context will return to the
+%% state it was previously.
+
+load([$<,$D,$i,$r,$e,$c,$t,$o,$r,$y,$ |Directory],[]) ->
+ Dir = httpd_conf:custom_clean(Directory,"",">"),
+ {ok,[{directory, Dir, [{path, Dir}]}]};
+load(eof,[{directory,Directory, DirData}|_]) ->
+ {error, ?NICE("Premature end-of-file in "++Directory)};
+
+load([$A,$u,$t,$h,$N,$a,$m,$e,$ |AuthName], [{directory,Directory, DirData}|Rest]) ->
+ {ok, [{directory,Directory,
+ [ {auth_name, httpd_conf:clean(AuthName)}|DirData]} | Rest ]};
+
+load([$A,$u,$t,$h,$U,$s,$e,$r,$F,$i,$l,$e,$ |AuthUserFile0],
+ [{directory, Directory, DirData}|Rest]) ->
+ AuthUserFile = httpd_conf:clean(AuthUserFile0),
+ {ok,[{directory,Directory,
+ [ {auth_user_file, AuthUserFile}|DirData]} | Rest ]};
+
+load([$A,$u,$t,$h,$G,$r,$o,$u,$p,$F,$i,$l,$e,$ |AuthGroupFile0],
+ [{directory,Directory, DirData}|Rest]) ->
+ AuthGroupFile = httpd_conf:clean(AuthGroupFile0),
+ {ok,[{directory,Directory,
+ [ {auth_group_file, AuthGroupFile}|DirData]} | Rest]};
+
+%AuthAccessPassword
+load([$A,$u,$t,$h,$A,$c,$c,$e,$s,$s,$P,$a,$s,$s,$w,$o,$r,$d,$ |AuthAccessPassword0],
+ [{directory,Directory, DirData}|Rest]) ->
+ AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0),
+ {ok,[{directory,Directory,
+ [{auth_access_password, AuthAccessPassword}|DirData]} | Rest]};
+
+
+
+
+load([$A,$u,$t,$h,$D,$B,$T,$y,$p,$e,$ |Type],
+ [{directory, Dir, DirData}|Rest]) ->
+ case httpd_conf:clean(Type) of
+ "plain" ->
+ {ok, [{directory, Dir, [{auth_type, plain}|DirData]} | Rest ]};
+ "mnesia" ->
+ {ok, [{directory, Dir, [{auth_type, mnesia}|DirData]} | Rest ]};
+ "dets" ->
+ {ok, [{directory, Dir, [{auth_type, dets}|DirData]} | Rest ]};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")}
+ end;
+
+load([$r,$e,$q,$u,$i,$r,$e,$ |Require],[{directory,Directory, DirData}|Rest]) ->
+ case regexp:split(Require," ") of
+ {ok,["user"|Users]} ->
+ {ok,[{directory,Directory,
+ [{require_user,Users}|DirData]} | Rest]};
+ {ok,["group"|Groups]} ->
+ {ok,[{directory,Directory,
+ [{require_group,Groups}|DirData]} | Rest]};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Require)++" is an invalid require")}
+ end;
+
+load([$a,$l,$l,$o,$w,$ |Allow],[{directory,Directory, DirData}|Rest]) ->
+ case regexp:split(Allow," ") of
+ {ok,["from","all"]} ->
+ {ok,[{directory,Directory,
+ [{allow_from,all}|DirData]} | Rest]};
+ {ok,["from"|Hosts]} ->
+ {ok,[{directory,Directory,
+ [{allow_from,Hosts}|DirData]} | Rest]};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Allow)++" is an invalid allow")}
+ end;
+
+load([$d,$e,$n,$y,$ |Deny],[{directory,Directory, DirData}|Rest]) ->
+ case regexp:split(Deny," ") of
+ {ok, ["from", "all"]} ->
+ {ok,[{directory, Directory,
+ [{deny_from, all}|DirData]} | Rest]};
+ {ok, ["from"|Hosts]} ->
+ {ok,[{directory, Directory,
+ [{deny_from, Hosts}|DirData]} | Rest]};
+ {ok, _} ->
+ {error,?NICE(httpd_conf:clean(Deny)++" is an invalid deny")}
+ end;
+
+load("</Directory>",[{directory,Directory, DirData}|Rest]) ->
+ {ok, Rest, {directory, Directory, DirData}};
+
+load([$A,$u,$t,$h,$M,$n,$e,$s,$i,$a,$D,$B,$ |AuthMnesiaDB],
+ [{directory, Dir, DirData}|Rest]) ->
+ case httpd_conf:clean(AuthMnesiaDB) of
+ "On" ->
+ {ok,[{directory,Dir,[{auth_type,mnesia}|DirData]}|Rest]};
+ "Off" ->
+ {ok,[{directory,Dir,[{auth_type,plain}|DirData]}|Rest]};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(AuthMnesiaDB)++" is an invalid AuthMnesiaDB")}
+ end.
+
+%% store
+
+store({directory,Directory0, DirData0}, ConfigList) ->
+ Port = httpd_util:key1search(ConfigList, port),
+ DirData = case httpd_util:key1search(ConfigList, bind_address) of
+ undefined ->
+ [{port, Port}|DirData0];
+ Addr ->
+ [{port, Port},{bind_address,Addr}|DirData0]
+ end,
+ Directory =
+ case filename:pathtype(Directory0) of
+ relative ->
+ SR = httpd_util:key1search(ConfigList, server_root),
+ filename:join(SR, Directory0);
+ _ ->
+ Directory0
+ end,
+ AuthMod =
+ case httpd_util:key1search(DirData0, auth_type) of
+ mnesia -> mod_auth_mnesia;
+ dets -> mod_auth_dets;
+ plain -> mod_auth_plain;
+ _ -> no_module_at_all
+ end,
+ case AuthMod of
+ no_module_at_all ->
+ {ok, {directory, Directory, DirData}};
+ _ ->
+ %% Control that there are a password or add a standard password:
+ %% "NoPassword"
+ %% In this way a user must select to use a noPassword
+ Pwd = case httpd_util:key1search(DirData,auth_access_password)of
+ undefined->
+ ?NOPASSWORD;
+ PassW->
+ PassW
+ end,
+ DirDataLast = lists:keydelete(auth_access_password,1,DirData),
+ case catch AuthMod:store_directory_data(Directory, DirDataLast) of
+ ok ->
+ add_auth_password(Directory,Pwd,ConfigList),
+ {ok, {directory, Directory, DirDataLast}};
+ {ok, NewDirData} ->
+ add_auth_password(Directory,Pwd,ConfigList),
+ {ok, {directory, Directory, NewDirData}};
+ {error, Reason} ->
+ {error, Reason};
+ Other ->
+ ?ERROR("unexpected result: ~p",[Other]),
+ {error, Other}
+ end
+ end.
+
+
+add_auth_password(Dir, Pwd0, ConfigList) ->
+ Addr = httpd_util:key1search(ConfigList, bind_address),
+ Port = httpd_util:key1search(ConfigList, port),
+ mod_auth_server:start(Addr, Port),
+ mod_auth_server:add_password(Addr, Port, Dir, Pwd0).
+
+%% remove
+
+
+remove(ConfigDB) ->
+ lists:foreach(fun({directory, Dir, DirData}) ->
+ AuthMod = auth_mod_name(DirData),
+ (catch apply(AuthMod, remove, [DirData]))
+ end,
+ ets:match_object(ConfigDB,{directory,'_','_'})),
+ Addr = case lookup(ConfigDB, bind_address) of
+ [] ->
+ undefined;
+ [{bind_address, Address}] ->
+ Address
+ end,
+ [{port, Port}] = lookup(ConfigDB, port),
+ mod_auth_server:stop(Addr, Port),
+ ok.
+
+
+
+
+%% --------------------------------------------------------------------
+
+%% update_password
+
+update_password(Port, Dir, Old, New, New)->
+ update_password(undefined, Port, Dir, Old, New, New).
+
+update_password(Addr, Port, Dir, Old, New, New) when list(New) ->
+ mod_auth_server:update_password(Addr, Port, Dir, Old, New);
+
+update_password(_Addr, _Port, _Dir, _Old, New, New) ->
+ {error, badtype};
+update_password(_Addr, _Port, _Dir, _Old, New, New1) ->
+ {error, notqeual}.
+
+
+%% add_user
+
+add_user(UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd}->
+ case get_options(Opt, userData) of
+ {error, Reason}->
+ {error, Reason};
+ {UserData, Password}->
+ User = [#httpd_user{username = UserName,
+ password = Password,
+ user_data = UserData}],
+ mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end
+ end.
+
+
+add_user(UserName, Password, UserData, Port, Dir) ->
+ add_user(UserName, Password, UserData, undefined, Port, Dir).
+add_user(UserName, Password, UserData, Addr, Port, Dir) ->
+ User = [#httpd_user{username = UserName,
+ password = Password,
+ user_data = UserData}],
+ mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD).
+
+
+%% get_user
+
+get_user(UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+get_user(UserName, Port, Dir) ->
+ get_user(UserName, undefined, Port, Dir).
+get_user(UserName, Addr, Port, Dir) ->
+ mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
+
+
+%% add_group_member
+
+add_group_member(GroupName, UserName, Opt)->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd}->
+ mod_auth_server:add_group_member(Addr, Port, Dir,
+ GroupName, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+add_group_member(GroupName, UserName, Port, Dir) ->
+ add_group_member(GroupName, UserName, undefined, Port, Dir).
+
+add_group_member(GroupName, UserName, Addr, Port, Dir) ->
+ mod_auth_server:add_group_member(Addr, Port, Dir,
+ GroupName, UserName, ?NOPASSWORD).
+
+
+%% delete_group_member
+
+delete_group_member(GroupName, UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:delete_group_member(Addr, Port, Dir,
+ GroupName, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+delete_group_member(GroupName, UserName, Port, Dir) ->
+ delete_group_member(GroupName, UserName, undefined, Port, Dir).
+delete_group_member(GroupName, UserName, Addr, Port, Dir) ->
+ mod_auth_server:delete_group_member(Addr, Port, Dir,
+ GroupName, UserName, ?NOPASSWORD).
+
+
+%% list_users
+
+list_users(Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:list_users(Addr, Port, Dir, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+list_users(Port, Dir) ->
+ list_users(undefined, Port, Dir).
+list_users(Addr, Port, Dir) ->
+ mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD).
+
+
+%% delete_user
+
+delete_user(UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+delete_user(UserName, Port, Dir) ->
+ delete_user(UserName, undefined, Port, Dir).
+delete_user(UserName, Addr, Port, Dir) ->
+ mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
+
+
+%% delete_group
+
+delete_group(GroupName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd}->
+ mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+delete_group(GroupName, Port, Dir) ->
+ delete_group(GroupName, undefined, Port, Dir).
+delete_group(GroupName, Addr, Port, Dir) ->
+ mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD).
+
+
+%% list_groups
+
+list_groups(Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd}->
+ mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+list_groups(Port, Dir) ->
+ list_groups(undefined, Port, Dir).
+list_groups(Addr, Port, Dir) ->
+ mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD).
+
+
+%% list_group_members
+
+list_group_members(GroupName,Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:list_group_members(Addr, Port, Dir, GroupName,
+ AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+list_group_members(GroupName, Port, Dir) ->
+ list_group_members(GroupName, undefined, Port, Dir).
+list_group_members(GroupName, Addr, Port, Dir) ->
+ mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, ?NOPASSWORD).
+
+
+
+%% Opt = [{port, Port},
+%% {addr, Addr},
+%% {dir, Dir},
+%% {authPassword, AuthPassword} | FunctionSpecificData]
+get_options(Opt, mandatory)->
+ case httpd_util:key1search(Opt, port, undefined) of
+ Port when integer(Port) ->
+ case httpd_util:key1search(Opt, dir, undefined) of
+ Dir when list(Dir) ->
+ Addr = httpd_util:key1search(Opt,
+ addr,
+ undefined),
+ AuthPwd = httpd_util:key1search(Opt,
+ authPassword,
+ ?NOPASSWORD),
+ {Addr, Port, Dir, AuthPwd};
+ _->
+ {error, bad_dir}
+ end;
+ _ ->
+ {error, bad_dir}
+ end;
+
+%% FunctionSpecificData = {userData, UserData} | {password, Password}
+get_options(Opt, userData)->
+ case httpd_util:key1search(Opt, userData, undefined) of
+ undefined ->
+ {error, no_userdata};
+ UserData ->
+ case httpd_util:key1search(Opt, password, undefined) of
+ undefined->
+ {error, no_password};
+ Pwd ->
+ {UserData, Pwd}
+ end
+ end.
+
+
+lookup(Db, Key) ->
+ ets:lookup(Db, Key).
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.hrl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.hrl
new file mode 100644
index 0000000000..ed3f437e60
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.hrl
@@ -0,0 +1,27 @@
+%% ``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_auth.hrl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
+%%
+
+-record(httpd_user,
+ {username,
+ password,
+ user_data}).
+
+-record(httpd_group,
+ {name,
+ userlist}).
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_dets.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_dets.erl
new file mode 100644
index 0000000000..89d8574e83
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_dets.erl
@@ -0,0 +1,222 @@
+%% ``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_auth_dets.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_auth_dets).
+
+%% dets authentication storage
+
+-export([get_user/2,
+ list_group_members/2,
+ add_user/2,
+ add_group_member/3,
+ list_users/1,
+ delete_user/2,
+ list_groups/1,
+ delete_group_member/3,
+ delete_group/2,
+ remove/1]).
+
+-export([store_directory_data/2]).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+store_directory_data(Directory, DirData) ->
+ ?CDEBUG("store_directory_data -> ~n"
+ " Directory: ~p~n"
+ " DirData: ~p",
+ [Directory, DirData]),
+
+ PWFile = httpd_util:key1search(DirData, auth_user_file),
+ GroupFile = httpd_util:key1search(DirData, auth_group_file),
+ Addr = httpd_util:key1search(DirData, bind_address),
+ Port = httpd_util:key1search(DirData, port),
+
+ PWName = httpd_util:make_name("httpd_dets_pwdb",Addr,Port),
+ case dets:open_file(PWName,[{type,set},{file,PWFile},{repair,true}]) of
+ {ok, PWDB} ->
+ GDBName = httpd_util:make_name("httpd_dets_groupdb",Addr,Port),
+ case dets:open_file(GDBName,[{type,set},{file,GroupFile},{repair,true}]) of
+ {ok, GDB} ->
+ NDD1 = lists:keyreplace(auth_user_file, 1, DirData,
+ {auth_user_file, PWDB}),
+ NDD2 = lists:keyreplace(auth_group_file, 1, NDD1,
+ {auth_group_file, GDB}),
+ {ok, NDD2};
+ {error, Err}->
+ {error, {{file, GroupFile},Err}}
+ end;
+ {error, Err2} ->
+ {error, {{file, PWFile},Err2}}
+ end.
+
+%%
+%% Storage format of users in the dets table:
+%% {{UserName, Addr, Port, Dir}, Password, UserData}
+%%
+
+add_user(DirData, UStruct) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ Record = {{UStruct#httpd_user.username, Addr, Port, Dir},
+ UStruct#httpd_user.password, UStruct#httpd_user.user_data},
+ case dets:lookup(PWDB, UStruct#httpd_user.username) of
+ [Record] ->
+ {error, user_already_in_db};
+ _ ->
+ dets:insert(PWDB, Record),
+ true
+ end.
+
+get_user(DirData, UserName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ User = {UserName, Addr, Port, Dir},
+ case dets:lookup(PWDB, User) of
+ [{User, Password, UserData}] ->
+ {ok, #httpd_user{username=UserName, password=Password, user_data=UserData}};
+ Other ->
+ {error, no_such_user}
+ end.
+
+list_users(DirData) ->
+ ?DEBUG("list_users -> ~n"
+ " DirData: ~p", [DirData]),
+ {Addr, Port, Dir} = lookup_common(DirData),
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ case dets:traverse(PWDB, fun(X) -> {continue, X} end) of %% SOOOO Ugly !
+ Records when list(Records) ->
+ ?DEBUG("list_users -> ~n"
+ " Records: ~p", [Records]),
+ {ok, [UserName || {{UserName, AnyAddr, AnyPort, AnyDir}, Password, _Data} <- Records,
+ AnyAddr == Addr, AnyPort == Port, AnyDir == Dir]};
+ O ->
+ ?DEBUG("list_users -> ~n"
+ " O: ~p", [O]),
+ {ok, []}
+ end.
+
+delete_user(DirData, UserName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ User = {UserName, Addr, Port, Dir},
+ case dets:lookup(PWDB, User) of
+ [{User, SomePassword, UserData}] ->
+ dets:delete(PWDB, User),
+ lists:foreach(fun(Group) -> delete_group_member(DirData, Group, UserName) end,
+ list_groups(DirData)),
+ true;
+ _ ->
+ {error, no_such_user}
+ end.
+
+%%
+%% Storage of groups in the dets table:
+%% {Group, UserList} where UserList is a list of strings.
+%%
+add_group_member(DirData, GroupName, UserName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ Group = {GroupName, Addr, Port, Dir},
+ case dets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ case lists:member(UserName, Users) of
+ true ->
+ true;
+ false ->
+ dets:insert(GDB, {Group, [UserName|Users]}),
+ true
+ end;
+ [] ->
+ dets:insert(GDB, {Group, [UserName]}),
+ true;
+ Other ->
+ {error, Other}
+ end.
+
+list_group_members(DirData, GroupName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ Group = {GroupName, Addr, Port, Dir},
+ case dets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ {ok, Users};
+ Other ->
+ {error, no_such_group}
+ end.
+
+list_groups(DirData) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ case dets:match(GDB, {'$1', '_'}) of
+ [] ->
+ {ok, []};
+ List when list(List) ->
+ Groups = lists:flatten(List),
+ {ok, [GroupName || {GroupName, AnyAddr, AnyPort, AnyDir} <- Groups,
+ AnyAddr == Addr, AnyPort == Port, AnyDir == Dir]};
+ _ ->
+ {ok, []}
+ end.
+
+delete_group_member(DirData, GroupName, UserName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ Group = {GroupName, Addr, Port, Dir},
+ case dets:lookup(GDB, GroupName) of
+ [{Group, Users}] ->
+ case lists:member(UserName, Users) of
+ true ->
+ dets:delete(GDB, Group),
+ dets:insert(GDB, {Group,
+ lists:delete(UserName, Users)}),
+ true;
+ false ->
+ {error, no_such_group_member}
+ end;
+ _ ->
+ {error, no_such_group}
+ end.
+
+delete_group(DirData, GroupName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ Group = {GroupName, Addr, Port, Dir},
+ case dets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ dets:delete(GDB, Group),
+ true;
+ _ ->
+ {error, no_such_group}
+ end.
+
+lookup_common(DirData) ->
+ Dir = httpd_util:key1search(DirData, path),
+ Port = httpd_util:key1search(DirData, port),
+ Addr = httpd_util:key1search(DirData, bind_address),
+ {Addr, Port, Dir}.
+
+%% remove/1
+%%
+%% Closes dets tables used by this auth mod.
+%%
+remove(DirData) ->
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ dets:close(GDB),
+ dets:close(PWDB),
+ ok.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_mnesia.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_mnesia.erl
new file mode 100644
index 0000000000..ec29022da0
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_mnesia.erl
@@ -0,0 +1,276 @@
+%% ``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_auth_mnesia.erl,v 1.2 2010/03/04 13:54:19 maria Exp $
+%%
+-module(mod_auth_mnesia).
+-export([get_user/2,
+ list_group_members/2,
+ add_user/2,
+ add_group_member/3,
+ list_users/1,
+ delete_user/2,
+ list_groups/1,
+ delete_group_member/3,
+ delete_group/2]).
+
+-export([store_user/5, store_user/6,
+ store_group_member/5, store_group_member/6,
+ list_group_members/3, list_group_members/4,
+ list_groups/2, list_groups/3,
+ list_users/2, list_users/3,
+ remove_user/4, remove_user/5,
+ remove_group_member/5, remove_group_member/6,
+ remove_group/4, remove_group/5]).
+
+-export([store_directory_data/2]).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+
+
+store_directory_data(Directory, DirData) ->
+ %% We don't need to do anything here, we could ofcourse check that the appropriate
+ %% mnesia tables has been created prior to starting the http server.
+ ok.
+
+
+%%
+%% API
+%%
+
+%% Compability API
+
+
+store_user(UserName, Password, Port, Dir, AccessPassword) ->
+ %% AccessPassword is ignored - was not used in previous version
+ DirData = [{path,Dir},{port,Port}],
+ UStruct = #httpd_user{username = UserName,
+ password = Password},
+ add_user(DirData, UStruct).
+
+store_user(UserName, Password, Addr, Port, Dir, AccessPassword) ->
+ %% AccessPassword is ignored - was not used in previous version
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ UStruct = #httpd_user{username = UserName,
+ password = Password},
+ add_user(DirData, UStruct).
+
+store_group_member(GroupName, UserName, Port, Dir, AccessPassword) ->
+ DirData = [{path,Dir},{port,Port}],
+ add_group_member(DirData, GroupName, UserName).
+
+store_group_member(GroupName, UserName, Addr, Port, Dir, AccessPassword) ->
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ add_group_member(DirData, GroupName, UserName).
+
+list_group_members(GroupName, Port, Dir) ->
+ DirData = [{path,Dir},{port,Port}],
+ list_group_members(DirData, GroupName).
+
+list_group_members(GroupName, Addr, Port, Dir) ->
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ list_group_members(DirData, GroupName).
+
+list_groups(Port, Dir) ->
+ DirData = [{path,Dir},{port,Port}],
+ list_groups(DirData).
+
+list_groups(Addr, Port, Dir) ->
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ list_groups(DirData).
+
+list_users(Port, Dir) ->
+ DirData = [{path,Dir},{port,Port}],
+ list_users(DirData).
+
+list_users(Addr, Port, Dir) ->
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ list_users(DirData).
+
+remove_user(UserName, Port, Dir, _AccessPassword) ->
+ DirData = [{path,Dir},{port,Port}],
+ delete_user(DirData, UserName).
+
+remove_user(UserName, Addr, Port, Dir, _AccessPassword) ->
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ delete_user(DirData, UserName).
+
+remove_group_member(GroupName,UserName,Port,Dir,_AccessPassword) ->
+ DirData = [{path,Dir},{port,Port}],
+ delete_group_member(DirData, GroupName, UserName).
+
+remove_group_member(GroupName,UserName,Addr,Port,Dir,_AccessPassword) ->
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ delete_group_member(DirData, GroupName, UserName).
+
+remove_group(GroupName,Port,Dir,_AccessPassword) ->
+ DirData = [{path,Dir},{port,Port}],
+ delete_group(DirData, GroupName).
+
+remove_group(GroupName,Addr,Port,Dir,_AccessPassword) ->
+ DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+ delete_group(DirData, GroupName).
+
+%%
+%% Storage format of users in the mnesia table:
+%% httpd_user records
+%%
+
+add_user(DirData, UStruct) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ UserName = UStruct#httpd_user.username,
+ Password = UStruct#httpd_user.password,
+ Data = UStruct#httpd_user.user_data,
+ User=#httpd_user{username={UserName,Addr,Port,Dir},
+ password=Password,
+ user_data=Data},
+ case mnesia:transaction(fun() -> mnesia:write(User) end) of
+ {aborted,Reason} ->
+ {error,Reason};
+ _ ->
+ true
+ end.
+
+get_user(DirData, UserName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ case mnesia:transaction(fun() ->
+ mnesia:read({httpd_user,
+ {UserName,Addr,Port,Dir}})
+ end) of
+ {aborted,Reason} ->
+ {error, Reason};
+ {'atomic',[]} ->
+ {error, no_such_user};
+ {'atomic', [Record]} when record(Record, httpd_user) ->
+ {ok, Record#httpd_user{username=UserName}};
+ Other ->
+ {error, no_such_user}
+ end.
+
+list_users(DirData) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ case mnesia:transaction(fun() ->
+ mnesia:match_object({httpd_user,
+ {'_',Addr,Port,Dir},'_','_'})
+ end) of
+ {aborted,Reason} ->
+ {error,Reason};
+ {'atomic',Users} ->
+ {ok,
+ lists:foldr(fun({httpd_user, {UserName, AnyAddr, AnyPort, AnyDir},
+ Password, Data}, Acc) ->
+ [UserName|Acc]
+ end,
+ [], Users)}
+ end.
+
+delete_user(DirData, UserName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ case mnesia:transaction(fun() ->
+ mnesia:delete({httpd_user,
+ {UserName,Addr,Port,Dir}})
+ end) of
+ {aborted,Reason} ->
+ {error,Reason};
+ _ ->
+ true
+ end.
+
+%%
+%% Storage of groups in the mnesia table:
+%% Multiple instances of {#httpd_group, User}
+%%
+
+add_group_member(DirData, GroupName, User) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ Group=#httpd_group{name={GroupName, Addr, Port, Dir}, userlist=User},
+ case mnesia:transaction(fun() -> mnesia:write(Group) end) of
+ {aborted,Reason} ->
+ {error,Reason};
+ _ ->
+ true
+ end.
+
+list_group_members(DirData, GroupName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ case mnesia:transaction(fun() ->
+ mnesia:read({httpd_group,
+ {GroupName,Addr,Port,Dir}})
+ end) of
+ {aborted, Reason} ->
+ {error,Reason};
+ {'atomic', Members} ->
+ {ok,[UserName || {httpd_group,{AnyGroupName,AnyAddr,AnyPort,AnyDir},UserName} <- Members,
+ AnyGroupName == GroupName, AnyAddr == Addr,
+ AnyPort == Port, AnyDir == Dir]}
+ end.
+
+list_groups(DirData) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ case mnesia:transaction(fun() ->
+ mnesia:match_object({httpd_group,
+ {'_',Addr,Port,Dir},'_'})
+ end) of
+ {aborted, Reason} ->
+ {error, Reason};
+ {'atomic', Groups} ->
+ GroupNames=
+ [GroupName || {httpd_group,{GroupName,AnyAddr,AnyPort,AnyDir}, UserName} <- Groups,
+ AnyAddr == Addr, AnyPort == AnyPort, AnyDir == Dir],
+ {ok, httpd_util:uniq(lists:sort(GroupNames))}
+ end.
+
+delete_group_member(DirData, GroupName, UserName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ Group = #httpd_group{name={GroupName, Addr, Port, Dir}, userlist=UserName},
+ case mnesia:transaction(fun() -> mnesia:delete_object(Group) end) of
+ {aborted,Reason} ->
+ {error,Reason};
+ _ ->
+ true
+ end.
+
+%% THIS IS WRONG (?) !
+%% Should first match out all httpd_group records for this group and then
+%% do mnesia:delete on those. Or ?
+
+delete_group(DirData, GroupName) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ case mnesia:transaction(fun() ->
+ mnesia:delete({httpd_group,
+ {GroupName,Addr,Port,Dir}})
+ end) of
+ {aborted,Reason} ->
+ {error,Reason};
+ _ ->
+ true
+ end.
+
+%% Utility functions.
+
+lookup_common(DirData) ->
+ Dir = httpd_util:key1search(DirData, path),
+ Port = httpd_util:key1search(DirData, port),
+ Addr = httpd_util:key1search(DirData, bind_address),
+ {Addr, Port, Dir}.
+
+
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_plain.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_plain.erl
new file mode 100644
index 0000000000..2f92dcb446
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_plain.erl
@@ -0,0 +1,344 @@
+%% ``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_auth_plain.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_auth_plain).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+-define(VMODULE,"AUTH_PLAIN").
+-include("httpd_verbosity.hrl").
+
+
+%% Internal API
+-export([store_directory_data/2]).
+
+
+-export([get_user/2,
+ list_group_members/2,
+ add_user/2,
+ add_group_member/3,
+ list_users/1,
+ delete_user/2,
+ list_groups/1,
+ delete_group_member/3,
+ delete_group/2,
+ remove/1]).
+
+%%
+%% API
+%%
+
+%%
+%% Storage format of users in the ets table:
+%% {UserName, Password, UserData}
+%%
+
+add_user(DirData, #httpd_user{username = User} = UStruct) ->
+ ?vtrace("add_user -> entry with:"
+ "~n User: ~p",[User]),
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ Record = {User,
+ UStruct#httpd_user.password,
+ UStruct#httpd_user.user_data},
+ case ets:lookup(PWDB, User) of
+ [{User, _SomePassword, _SomeData}] ->
+ {error, user_already_in_db};
+ _ ->
+ ets:insert(PWDB, Record),
+ true
+ end.
+
+get_user(DirData, User) ->
+ ?vtrace("get_user -> entry with:"
+ "~n User: ~p",[User]),
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ case ets:lookup(PWDB, User) of
+ [{User, PassWd, Data}] ->
+ {ok, #httpd_user{username=User, password=PassWd, user_data=Data}};
+ _ ->
+ {error, no_such_user}
+ end.
+
+list_users(DirData) ->
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ case ets:match(PWDB, '$1') of
+ Records when list(Records) ->
+ {ok, lists:foldr(fun({User,PassWd,Data}, A) -> [User|A] end,
+ [], lists:flatten(Records))};
+ O ->
+ {ok, []}
+ end.
+
+delete_user(DirData, UserName) ->
+ ?vtrace("delete_user -> entry with:"
+ "~n UserName: ~p",[UserName]),
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ case ets:lookup(PWDB, UserName) of
+ [{UserName, SomePassword, SomeData}] ->
+ ets:delete(PWDB, UserName),
+ case list_groups(DirData) of
+ {ok,Groups}->
+ lists:foreach(fun(Group) ->
+ delete_group_member(DirData, Group, UserName)
+ end,Groups),
+ true;
+ _->
+ true
+ end;
+ _ ->
+ {error, no_such_user}
+ end.
+
+%%
+%% Storage of groups in the ets table:
+%% {Group, UserList} where UserList is a list of strings.
+%%
+
+add_group_member(DirData, Group, UserName) ->
+ ?DEBUG("add_group_members -> ~n"
+ " Group: ~p~n"
+ " UserName: ~p",[Group,UserName]),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ case ets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ case lists:member(UserName, Users) of
+ true ->
+ ?DEBUG("add_group_members -> already member in group",[]),
+ true;
+ false ->
+ ?DEBUG("add_group_members -> add",[]),
+ ets:insert(GDB, {Group, [UserName|Users]}),
+ true
+ end;
+ [] ->
+ ?DEBUG("add_group_members -> create grouo",[]),
+ ets:insert(GDB, {Group, [UserName]}),
+ true;
+ Other ->
+ ?ERROR("add_group_members -> Other: ~p",[Other]),
+ {error, Other}
+ end.
+
+list_group_members(DirData, Group) ->
+ ?DEBUG("list_group_members -> Group: ~p",[Group]),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ case ets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ ?DEBUG("list_group_members -> Users: ~p",[Users]),
+ {ok, Users};
+ _ ->
+ {error, no_such_group}
+ end.
+
+list_groups(DirData) ->
+ ?DEBUG("list_groups -> entry",[]),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ case ets:match(GDB, '$1') of
+ [] ->
+ ?DEBUG("list_groups -> []",[]),
+ {ok, []};
+ Groups0 when list(Groups0) ->
+ ?DEBUG("list_groups -> Groups0: ~p",[Groups0]),
+ {ok, httpd_util:uniq(lists:foldr(fun({G, U}, A) -> [G|A] end,
+ [], lists:flatten(Groups0)))};
+ _ ->
+ {ok, []}
+ end.
+
+delete_group_member(DirData, Group, User) ->
+ ?DEBUG("list_group_members -> ~n"
+ " Group: ~p~n"
+ " User: ~p",[Group,User]),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ UDB = httpd_util:key1search(DirData, auth_user_file),
+ case ets:lookup(GDB, Group) of
+ [{Group, Users}] when list(Users) ->
+ case lists:member(User, Users) of
+ true ->
+ ?DEBUG("list_group_members -> deleted from group",[]),
+ ets:delete(GDB, Group),
+ ets:insert(GDB, {Group, lists:delete(User, Users)}),
+ true;
+ false ->
+ ?DEBUG("list_group_members -> not member",[]),
+ {error, no_such_group_member}
+ end;
+ _ ->
+ ?ERROR("list_group_members -> no such group",[]),
+ {error, no_such_group}
+ end.
+
+delete_group(DirData, Group) ->
+ ?DEBUG("list_group_members -> Group: ~p",[Group]),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ case ets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ ?DEBUG("list_group_members -> delete",[]),
+ ets:delete(GDB, Group),
+ true;
+ _ ->
+ ?ERROR("delete_group -> no such group",[]),
+ {error, no_such_group}
+ end.
+
+
+store_directory_data(Directory, DirData) ->
+ PWFile = httpd_util:key1search(DirData, auth_user_file),
+ GroupFile = httpd_util:key1search(DirData, auth_group_file),
+ case load_passwd(PWFile) of
+ {ok, PWDB} ->
+ case load_group(GroupFile) of
+ {ok, GRDB} ->
+ %% Address and port is included in the file names...
+ Addr = httpd_util:key1search(DirData, bind_address),
+ Port = httpd_util:key1search(DirData, port),
+ {ok, PasswdDB} = store_passwd(Addr,Port,PWDB),
+ {ok, GroupDB} = store_group(Addr,Port,GRDB),
+ NDD1 = lists:keyreplace(auth_user_file, 1, DirData,
+ {auth_user_file, PasswdDB}),
+ NDD2 = lists:keyreplace(auth_group_file, 1, NDD1,
+ {auth_group_file, GroupDB}),
+ {ok, NDD2};
+ Err ->
+ ?ERROR("failed storing directory data: "
+ "load group error: ~p",[Err]),
+ {error, Err}
+ end;
+ Err2 ->
+ ?ERROR("failed storing directory data: "
+ "load passwd error: ~p",[Err2]),
+ {error, Err2}
+ end.
+
+
+
+%% load_passwd
+
+load_passwd(AuthUserFile) ->
+ case file:open(AuthUserFile, [read]) of
+ {ok,Stream} ->
+ parse_passwd(Stream, []);
+ {error, _} ->
+ {error, ?NICE("Can't open "++AuthUserFile)}
+ end.
+
+parse_passwd(Stream,PasswdList) ->
+ Line =
+ case io:get_line(Stream, '') of
+ eof ->
+ eof;
+ String ->
+ httpd_conf:clean(String)
+ end,
+ parse_passwd(Stream, PasswdList, Line).
+
+parse_passwd(Stream, PasswdList, eof) ->
+ file:close(Stream),
+ {ok, PasswdList};
+parse_passwd(Stream, PasswdList, "") ->
+ parse_passwd(Stream, PasswdList);
+parse_passwd(Stream, PasswdList, [$#|_]) ->
+ parse_passwd(Stream, PasswdList);
+parse_passwd(Stream, PasswdList, Line) ->
+ case regexp:split(Line,":") of
+ {ok, [User,Password]} ->
+ parse_passwd(Stream, [{User,Password, []}|PasswdList]);
+ {ok,_} ->
+ {error, ?NICE(Line)}
+ end.
+
+%% load_group
+
+load_group(AuthGroupFile) ->
+ case file:open(AuthGroupFile, [read]) of
+ {ok, Stream} ->
+ parse_group(Stream,[]);
+ {error, _} ->
+ {error, ?NICE("Can't open "++AuthGroupFile)}
+ end.
+
+parse_group(Stream, GroupList) ->
+ Line=
+ case io:get_line(Stream,'') of
+ eof ->
+ eof;
+ String ->
+ httpd_conf:clean(String)
+ end,
+ parse_group(Stream, GroupList, Line).
+
+parse_group(Stream, GroupList, eof) ->
+ file:close(Stream),
+ {ok, GroupList};
+parse_group(Stream, GroupList, "") ->
+ parse_group(Stream, GroupList);
+parse_group(Stream, GroupList, [$#|_]) ->
+ parse_group(Stream, GroupList);
+parse_group(Stream, GroupList, Line) ->
+ case regexp:split(Line, ":") of
+ {ok, [Group,Users]} ->
+ {ok, UserList} = regexp:split(Users," "),
+ parse_group(Stream, [{Group,UserList}|GroupList]);
+ {ok, _} ->
+ {error, ?NICE(Line)}
+ end.
+
+
+%% store_passwd
+
+store_passwd(Addr,Port,PasswdList) ->
+ Name = httpd_util:make_name("httpd_passwd",Addr,Port),
+ PasswdDB = ets:new(Name, [set, public]),
+ store_passwd(PasswdDB, PasswdList).
+
+store_passwd(PasswdDB, []) ->
+ {ok, PasswdDB};
+store_passwd(PasswdDB, [User|Rest]) ->
+ ets:insert(PasswdDB, User),
+ store_passwd(PasswdDB, Rest).
+
+%% store_group
+
+store_group(Addr,Port,GroupList) ->
+ Name = httpd_util:make_name("httpd_group",Addr,Port),
+ GroupDB = ets:new(Name, [set, public]),
+ store_group(GroupDB, GroupList).
+
+
+store_group(GroupDB,[]) ->
+ {ok, GroupDB};
+store_group(GroupDB,[User|Rest]) ->
+ ets:insert(GroupDB, User),
+ store_group(GroupDB, Rest).
+
+
+%% remove/1
+%%
+%% Deletes ets tables used by this auth mod.
+%%
+remove(DirData) ->
+ PWDB = httpd_util:key1search(DirData, auth_user_file),
+ GDB = httpd_util:key1search(DirData, auth_group_file),
+ ets:delete(PWDB),
+ ets:delete(GDB).
+
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_server.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_server.erl
new file mode 100644
index 0000000000..6694ed7eac
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_server.erl
@@ -0,0 +1,424 @@
+%% ``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_auth_server.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+
+-module(mod_auth_server).
+
+-include("httpd.hrl").
+%% -include("mod_auth.hrl").
+-include("httpd_verbosity.hrl").
+
+-behaviour(gen_server).
+
+
+%% mod_auth exports
+-export([start/2, stop/2,
+ add_password/4, update_password/5,
+ add_user/5, delete_user/5, get_user/5, list_users/4,
+ add_group_member/6, delete_group_member/6, list_group_members/5,
+ delete_group/5, list_groups/4]).
+
+%% Management exports
+-export([verbosity/3]).
+
+%% gen_server exports
+-export([start_link/3,
+ init/1,
+ handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+
+-record(state,{tab}).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% External API %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% start_link/3
+%%
+%% NOTE: This is called by httpd_misc_sup when the process is started
+%%
+start_link(Addr, Port, Verbosity)->
+ ?vlog("start_link -> entry with"
+ "~n Addr: ~p"
+ "~n Port: ~p", [Addr, Port]),
+ Name = make_name(Addr, Port),
+ gen_server:start_link({local, Name}, ?MODULE, [Verbosity],
+ [{timeout, infinity}]).
+
+
+%% start/2
+
+start(Addr, Port)->
+ ?vtrace("start -> entry with"
+ "~n Addr: ~p"
+ "~n Port: ~p", [Addr, Port]),
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined ->
+ Verbosity = get(auth_verbosity),
+ case (catch httpd_misc_sup:start_auth_server(Addr, Port,
+ Verbosity)) of
+ {ok, Pid} ->
+ put(auth_server, Pid),
+ ok;
+ {error, Reason} ->
+ exit({failed_start_auth_server, Reason});
+ Error ->
+ exit({failed_start_auth_server, Error})
+ end;
+ _ -> %% Already started...
+ ok
+ end.
+
+
+%% stop/2
+
+stop(Addr, Port)->
+ ?vtrace("stop -> entry with"
+ "~n Addr: ~p"
+ "~n Port: ~p", [Addr, Port]),
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined -> %% Already stopped
+ ok;
+ _ ->
+ (catch httpd_misc_sup:stop_auth_server(Addr, Port))
+ end.
+
+
+%% verbosity/3
+
+verbosity(Addr, Port, Verbosity) ->
+ Name = make_name(Addr, Port),
+ Req = {verbosity, Verbosity},
+ call(Name, Req).
+
+
+%% add_password/4
+
+add_password(Addr, Port, Dir, Password)->
+ Name = make_name(Addr, Port),
+ Req = {add_password, Dir, Password},
+ call(Name, Req).
+
+
+%% update_password/6
+
+update_password(Addr, Port, Dir, Old, New) when list(New) ->
+ Name = make_name(Addr, Port),
+ Req = {update_password, Dir, Old, New},
+ call(Name, Req).
+
+
+%% add_user/5
+
+add_user(Addr, Port, Dir, User, Password) ->
+ Name = make_name(Addr, Port),
+ Req = {add_user, Addr, Port, Dir, User, Password},
+ call(Name, Req).
+
+
+%% delete_user/5
+
+delete_user(Addr, Port, Dir, UserName, Password) ->
+ Name = make_name(Addr, Port),
+ Req = {delete_user, Addr, Port, Dir, UserName, Password},
+ call(Name, Req).
+
+
+%% get_user/5
+
+get_user(Addr, Port, Dir, UserName, Password) ->
+ Name = make_name(Addr, Port),
+ Req = {get_user, Addr, Port, Dir, UserName, Password},
+ call(Name, Req).
+
+
+%% list_users/4
+
+list_users(Addr, Port, Dir, Password) ->
+ Name = make_name(Addr,Port),
+ Req = {list_users, Addr, Port, Dir, Password},
+ call(Name, Req).
+
+
+%% add_group_member/6
+
+add_group_member(Addr, Port, Dir, GroupName, UserName, Password) ->
+ Name = make_name(Addr,Port),
+ Req = {add_group_member, Addr, Port, Dir, GroupName, UserName, Password},
+ call(Name, Req).
+
+
+%% delete_group_member/6
+
+delete_group_member(Addr, Port, Dir, GroupName, UserName, Password) ->
+ Name = make_name(Addr,Port),
+ Req = {delete_group_member, Addr, Port, Dir, GroupName, UserName, Password},
+ call(Name, Req).
+
+
+%% list_group_members/4
+
+list_group_members(Addr, Port, Dir, Group, Password) ->
+ Name = make_name(Addr, Port),
+ Req = {list_group_members, Addr, Port, Dir, Group, Password},
+ call(Name, Req).
+
+
+%% delete_group/5
+
+delete_group(Addr, Port, Dir, GroupName, Password) ->
+ Name = make_name(Addr, Port),
+ Req = {delete_group, Addr, Port, Dir, GroupName, Password},
+ call(Name, Req).
+
+
+%% list_groups/4
+
+list_groups(Addr, Port, Dir, Password) ->
+ Name = make_name(Addr, Port),
+ Req = {list_groups, Addr, Port, Dir, Password},
+ call(Name, Req).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Server call-back functions %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% init
+
+init([undefined]) ->
+ init([?default_verbosity]);
+
+init([Verbosity]) ->
+ put(sname,auth),
+ put(verbosity,Verbosity),
+ ?vlog("starting",[]),
+ {ok,#state{tab = ets:new(auth_pwd,[set,protected])}}.
+
+
+%% handle_call
+
+%% Add a user
+handle_call({add_user, Addr, Port, Dir, User, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Dir, add_user, User, AuthPwd, State),
+ {reply, Reply, State};
+
+%% Get data about a user
+handle_call({get_user, Addr, Port, Dir, User, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Dir, get_user, [User], AuthPwd, State),
+ {reply, Reply, State};
+
+%% Add a group member
+handle_call({add_group_member, Addr, Port, Dir, Group, User, AuthPwd},
+ _From, State) ->
+ Reply = api_call(Addr, Port, Dir, add_group_member, [Group, User],
+ AuthPwd, State),
+ {reply, Reply, State};
+
+%% delete a group
+handle_call({delete_group_member, Addr, Port, Dir, Group, User, AuthPwd},
+ _From, State)->
+ Reply = api_call(Addr, Port, Dir, delete_group_member, [Group, User],
+ AuthPwd, State),
+ {reply, Reply, State};
+
+%% List all users thats standalone users
+handle_call({list_users, Addr, Port, Dir, AuthPwd}, _From, State)->
+ Reply = api_call(Addr, Port, Dir, list_users, [], AuthPwd, State),
+ {reply, Reply, State};
+
+%% Delete a user
+handle_call({delete_user, Addr, Port, Dir, User, AuthPwd}, _From, State)->
+ Reply = api_call(Addr, Port, Dir, delete_user, [User], AuthPwd, State),
+ {reply, Reply, State};
+
+%% Delete a group
+handle_call({delete_group, Addr, Port, Dir, Group, AuthPwd}, _From, State)->
+ Reply = api_call(Addr, Port, Dir, delete_group, [Group], AuthPwd, State),
+ {reply, Reply, State};
+
+%% List the current groups
+handle_call({list_groups, Addr, Port, Dir, AuthPwd}, _From, State)->
+ Reply = api_call(Addr, Port, Dir, list_groups, [], AuthPwd, State),
+ {reply, Reply, State};
+
+%% List the members of the given group
+handle_call({list_group_members, Addr, Port, Dir, Group, AuthPwd},
+ _From, State)->
+ Reply = api_call(Addr, Port, Dir, list_group_members, [Group],
+ AuthPwd, State),
+ {reply, Reply, State};
+
+
+%% Add password for a directory
+handle_call({add_password, Dir, Password}, _From, State)->
+ Reply = do_add_password(Dir, Password, State),
+ {reply, Reply, State};
+
+
+%% Update the password for a directory
+
+handle_call({update_password, Dir, Old, New},_From,State)->
+ Reply =
+ case getPassword(State, Dir) of
+ OldPwd when binary(OldPwd)->
+ case erlang:md5(Old) of
+ OldPwd ->
+ %% The old password is right =>
+ %% update the password to the new
+ do_update_password(Dir,New,State),
+ ok;
+ _->
+ {error, error_new}
+ end;
+ _->
+ {error, error_old}
+ end,
+ {reply, Reply, State};
+
+handle_call(stop, _From, State)->
+ {stop, normal, State};
+
+handle_call({verbosity,Verbosity},_From,State)->
+ OldVerbosity = put(verbosity,Verbosity),
+ ?vlog("set verbosity: ~p -> ~p",[Verbosity,OldVerbosity]),
+ {reply,OldVerbosity,State}.
+
+handle_info(Info,State)->
+ {noreply,State}.
+
+handle_cast(Request,State)->
+ {noreply,State}.
+
+
+terminate(Reason,State) ->
+ ets:delete(State#state.tab),
+ ok.
+
+
+%% code_change({down, ToVsn}, State, Extra)
+%%
+code_change({down, _}, #state{tab = Tab}, downgrade_to_2_6_0) ->
+ ?vlog("downgrade to 2.6.0", []),
+ {ok, {state, Tab, undefined}};
+
+
+%% code_change(FromVsn, State, Extra)
+%%
+code_change(_, {state, Tab, _}, upgrade_from_2_6_0) ->
+ ?vlog("upgrade from 2.6.0", []),
+ {ok, #state{tab = Tab}}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The functions that really changes the data in the database %%
+%% of users to different directories %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% API gateway
+
+api_call(Addr, Port, Dir, Func, Args,Password,State) ->
+ case controlPassword(Password,State,Dir) of
+ ok->
+ ConfigName = httpd_util:make_name("httpd_conf",Addr,Port),
+ case ets:match_object(ConfigName, {directory, Dir, '$1'}) of
+ [{directory, Dir, DirData}] ->
+ AuthMod = auth_mod_name(DirData),
+ ?DEBUG("api_call -> call ~p:~p",[AuthMod,Func]),
+ Ret = (catch apply(AuthMod, Func, [DirData|Args])),
+ ?DEBUG("api_call -> Ret: ~p",[ret]),
+ Ret;
+ O ->
+ ?DEBUG("api_call -> O: ~p",[O]),
+ {error, no_such_directory}
+ end;
+ bad_password ->
+ {error,bad_password}
+ end.
+
+controlPassword(Password,State,Dir)when Password=:="DummyPassword"->
+ bad_password;
+
+controlPassword(Password,State,Dir)->
+ case getPassword(State,Dir) of
+ Pwd when binary(Pwd)->
+ case erlang:md5(Password) of
+ Pwd ->
+ ok;
+ _->
+ bad_password
+ end;
+ _ ->
+ bad_password
+ end.
+
+
+getPassword(State,Dir)->
+ case lookup(State#state.tab, Dir) of
+ [{_,Pwd}]->
+ Pwd;
+ _ ->
+ {error,bad_password}
+ end.
+
+do_update_password(Dir, New, State) ->
+ ets:insert(State#state.tab, {Dir, erlang:md5(New)}).
+
+do_add_password(Dir, Password, State) ->
+ case getPassword(State,Dir) of
+ PwdExists when binary(PwdExists) ->
+ {error, dir_protected};
+ {error, _} ->
+ do_update_password(Dir, Password, State)
+ end.
+
+
+auth_mod_name(DirData) ->
+ case httpd_util:key1search(DirData, auth_type, plain) of
+ plain -> mod_auth_plain;
+ mnesia -> mod_auth_mnesia;
+ dets -> mod_auth_dets
+ end.
+
+
+lookup(Db, Key) ->
+ ets:lookup(Db, Key).
+
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd_auth",Addr,Port).
+
+
+call(Name, Req) ->
+ case (catch gen_server:call(Name, Req)) of
+ {'EXIT', Reason} ->
+ {error, Reason};
+ Reply ->
+ Reply
+ end.
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_browser.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_browser.erl
new file mode 100644
index 0000000000..62ffba0e5b
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_browser.erl
@@ -0,0 +1,214 @@
+%% ``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_browser.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+%% ----------------------------------------------------------------------
+%%
+%% Browsers sends a string to the webbserver
+%% to identify themsevles. They are a bit nasty
+%% since the only thing that the specification really
+%% is strict about is that they shall be short
+%% tree axamples:
+%%
+%% Netscape Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u)
+%% IE5 Mozilla/4.0 (compatible; MSIE 5.0; SP1B; SunOS 5.8 sun4u; X11)
+%% Lynx Lynx/2.8.3rel.1 libwww-FM/2.142
+%%
+%% ----------------------------------------------------------------------
+
+-module(mod_browser).
+
+%% Remember that the order of the mozilla browsers are
+%% important since some browsers include others to behave
+%% as they were something else
+-define(MOZILLA_BROWSERS,[{opera,"opera"},{msie,"msie"}]).
+
+
+%% If your operatingsystem is not recognized add it to this list.
+-define(OPERATIVE_SYSTEMS,[{win3x,["win16","windows 3","windows 16-bit"]},
+ {win95,["win95","windows 95"]},
+ {win98,["win98", "windows 98"]},
+ {winnt,["winnt", "windows nt"]},
+ {win2k,["nt 5"]},
+ {sunos4,["sunos 4"]},
+ {sunos5,["sunos 5"]},
+ {sun,["sunos"]},
+ {aix,["aix"]},
+ {linux,["linux"]},
+ {sco,["sco","unix_sv"]},
+ {freebsd,["freebsd"]},
+ {bsd,["bsd"]}]).
+
+-define(LYNX,lynx).
+-define(MOZILLA,mozilla).
+-define(EMACS,emacs).
+-define(STAROFFICE,soffice).
+-define(MOSAIC,mosaic).
+-define(NETSCAPE,netscape).
+-define(UNKOWN,unknown).
+
+-include("httpd.hrl").
+
+-export([do/1, test/0, getBrowser/1]).
+
+
+do(Info) ->
+ case httpd_util:key1search(Info#mod.data,status) of
+ {Status_code,PhraseArgs,Reason} ->
+ {proceed,Info#mod.data};
+ undefined ->
+ {proceed,[{'user-agent',getBrowser1(Info)}|Info#mod.data]}
+ end.
+
+getBrowser1(Info) ->
+ PHead=Info#mod.parsed_header,
+ case httpd_util:key1search(PHead,"User-Agent") of
+ undefined->
+ undefined;
+ AgentString ->
+ getBrowser(AgentString)
+ end.
+
+getBrowser(AgentString) ->
+ LAgentString = httpd_util:to_lower(AgentString),
+ case regexp:first_match(LAgentString,"^[^ ]*") of
+ {match,Start,Length} ->
+ Browser=lists:sublist(LAgentString,Start,Length),
+ case browserType(Browser) of
+ {mozilla,Vsn} ->
+ {getMozilla(LAgentString,
+ ?MOZILLA_BROWSERS,{?NETSCAPE,Vsn}),
+ operativeSystem(LAgentString)};
+ AnyBrowser ->
+ {AnyBrowser,operativeSystem(LAgentString)}
+ end;
+ nomatch ->
+ browserType(LAgentString)
+ end.
+
+browserType([$l,$y,$n,$x|Version]) ->
+ {?LYNX,browserVersion(Version)};
+browserType([$m,$o,$z,$i,$l,$l,$a|Version]) ->
+ {?MOZILLA,browserVersion(Version)};
+browserType([$e,$m,$a,$c,$s|Version]) ->
+ {?EMACS,browserVersion(Version)};
+browserType([$e,$t,$a,$r,$o,$f,$f,$i,$c,$e|Version]) ->
+ {?STAROFFICE,browserVersion(Version)};
+browserType([$m,$o,$s,$a,$i,$c|Version]) ->
+ {?MOSAIC,browserVersion(Version)};
+browserType(Unknown)->
+ unknown.
+
+
+browserVersion([$/|VsnString]) ->
+ case catch list_to_float(VsnString) of
+ Number when float(Number) ->
+ Number;
+ Whatever ->
+ case string:span(VsnString,"1234567890.") of
+ 0 ->
+ unknown;
+ VLength ->
+ Vsn = string:substr(VsnString,1,VLength),
+ case string:tokens(Vsn,".") of
+ [Number] ->
+ list_to_float(Number++".0");
+ [Major,Minor|_MinorMinor] ->
+ list_to_float(Major++"."++Minor)
+ end
+ end
+ end;
+browserVersion(VsnString) ->
+ browserVersion([$/|VsnString]).
+
+operativeSystem(OpString) ->
+ operativeSystem(OpString, ?OPERATIVE_SYSTEMS).
+
+operativeSystem(OpString,[]) ->
+ unknown;
+operativeSystem(OpString,[{RetVal,RegExps}|Rest]) ->
+ case controlOperativeSystem(OpString,RegExps) of
+ true->
+ RetVal;
+ _ ->
+ operativeSystem(OpString,Rest)
+ end.
+
+controlOperativeSystem(OpString,[]) ->
+ false;
+controlOperativeSystem(OpString,[Regexp|Regexps]) ->
+ case regexp:match(OpString,Regexp) of
+ {match,_,_}->
+ true;
+ nomatch->
+ controlOperativeSystem(OpString,Regexps)
+ end.
+
+
+%% OK this is ugly but thats the only way since
+%% all browsers dont conform to the name/vsn standard
+%% First we check if it is one of the browsers that
+%% not are the default mozillaborwser against the regexp
+%% for the different browsers. if no match it a mozilla
+%% browser i.e opera netscape or internet explorer
+
+getMozilla(AgentString,[],Default) ->
+ Default;
+getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) ->
+ case regexp:match(AgentString,AgentRegExp) of
+ {match,_,_} ->
+ {Agent,getVersion(AgentString,AgentRegExp)};
+ nomatch ->
+ getMozilla(AgentString,Rest,Default)
+ end.
+
+getVersion(AgentString,AgentRegExp) ->
+ case regexp:match(AgentString,AgentRegExp++"[0-9\.\ ]*") of
+ {match,Start,Length} when length(AgentRegExp) < Length ->
+ %% Ok we got the number split it out
+ RealStart=Start+length(AgentRegExp),
+ RealLength=Length-length(AgentRegExp),
+ VsnString=string:substr(AgentString,RealStart,RealLength),
+ case string:strip(VsnString,both,$\ ) of
+ [] ->
+ unknown;
+ Vsn ->
+ case string:tokens(Vsn,".") of
+ [Number]->
+ list_to_float(Number++".0");
+ [Major,Minor|_MinorMinor]->
+ list_to_float(Major++"."++Minor)
+ end
+ end;
+ nomatch ->
+ unknown
+ end.
+
+
+test()->
+ io:format("~n--------------------------------------------------------~n"),
+ Res1=getBrowser("Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u)"),
+ io:format("~p",[Res1]),
+ io:format("~n--------------------------------------------------------~n"),
+ io:format("~n--------------------------------------------------------~n"),
+ Res2=getBrowser("Mozilla/4.0 (compatible; MSIE 5.0; SP1B; SunOS 5.8 sun4u; X11)"),
+ io:format("~p",[Res2]),
+ io:format("~n--------------------------------------------------------~n"),
+ io:format("~n--------------------------------------------------------~n"),
+ Res3=getBrowser("Lynx/2.8.3rel.1 libwww-FM/2.142"),
+ io:format("~p",[Res3]),
+ io:format("~n--------------------------------------------------------~n").
+
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.
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_dir.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_dir.erl
new file mode 100644
index 0000000000..449b088055
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_dir.erl
@@ -0,0 +1,266 @@
+%% ``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_dir.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_dir).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ case Info#mod.method of
+ "GET" ->
+ 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ do_dir(Info);
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end;
+ %% Not a GET method!
+ _ ->
+ {proceed,Info#mod.data}
+ end.
+
+do_dir(Info) ->
+ ?DEBUG("do_dir -> Request URI: ~p",[Info#mod.request_uri]),
+ Path = mod_alias:path(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri),
+ DefaultPath = mod_alias:default_index(Info#mod.config_db,Path),
+ %% Is it a directory?
+ case file:read_file_info(DefaultPath) of
+ {ok,FileInfo} when FileInfo#file_info.type == directory ->
+ DecodedRequestURI =
+ httpd_util:decode_hex(Info#mod.request_uri),
+ ?DEBUG("do_dir -> ~n"
+ " Path: ~p~n"
+ " DefaultPath: ~p~n"
+ " DecodedRequestURI: ~p",
+ [Path,DefaultPath,DecodedRequestURI]),
+ case dir(DefaultPath,string:strip(DecodedRequestURI,right,$/),Info#mod.config_db) of
+ {ok, Dir} ->
+ Head=[{content_type,"text/html"},
+ {content_length,integer_to_list(httpd_util:flatlength(Dir))},
+ {date,httpd_util:rfc1123_date(FileInfo#file_info.mtime)},
+ {code,200}],
+ {proceed,[{response,{response,Head,Dir}},
+ {mime_type,"text/html"}|Info#mod.data]};
+ {error, Reason} ->
+ ?ERROR("do_dir -> dir operation failed: ~p",[Reason]),
+ {proceed,
+ [{status,{404,Info#mod.request_uri,Reason}}|
+ Info#mod.data]}
+ end;
+ {ok,FileInfo} ->
+ ?DEBUG("do_dir -> ~n"
+ " Path: ~p~n"
+ " DefaultPath: ~p~n"
+ " FileInfo: ~p",
+ [Path,DefaultPath,FileInfo]),
+ {proceed,Info#mod.data};
+ {error,Reason} ->
+ ?LOG("do_dir -> failed reading file info (~p) for: ~p",
+ [Reason,DefaultPath]),
+ {proceed,
+ [{status,read_file_info_error(Reason,Info,DefaultPath)}|
+ Info#mod.data]}
+ end.
+
+dir(Path,RequestURI,ConfigDB) ->
+ case file:list_dir(Path) of
+ {ok,FileList} ->
+ SortedFileList=lists:sort(FileList),
+ {ok,[header(Path,RequestURI),
+ body(Path,RequestURI,ConfigDB,SortedFileList),
+ footer(Path,SortedFileList)]};
+ {error,Reason} ->
+ {error,?NICE("Can't open directory "++Path++": "++Reason)}
+ end.
+
+%% header
+
+header(Path,RequestURI) ->
+ Header=
+ "<HTML>\n<HEAD>\n<TITLE>Index of "++RequestURI++"</TITLE>\n</HEAD>\n<BODY>\n<H1>Index of "++
+ RequestURI++"</H1>\n<PRE><IMG SRC=\""++icon(blank)++
+ "\" ALT=" "> Name Last modified Size Description
+<HR>\n",
+ case regexp:sub(RequestURI,"[^/]*\$","") of
+ {ok,"/",_} ->
+ Header;
+ {ok,ParentRequestURI,_} ->
+ {ok,ParentPath,_}=regexp:sub(string:strip(Path,right,$/),"[^/]*\$",""),
+ Header++format(ParentPath,ParentRequestURI)
+ end.
+
+format(Path,RequestURI) ->
+ {ok,FileInfo}=file:read_file_info(Path),
+ {{Year,Month,Day},{Hour,Minute,Second}}=FileInfo#file_info.mtime,
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> <A HREF=\"~s\">Parent directory</A> ~2.2.0w-~s-~w ~2.2.0w:~2.2.0w -\n",
+ [icon(back),"DIR",RequestURI,Day,
+ httpd_util:month(Month),Year,Hour,Minute]).
+
+%% body
+
+body(Path,RequestURI,ConfigDB,[]) ->
+ [];
+body(Path,RequestURI,ConfigDB,[Entry|Rest]) ->
+ [format(Path,RequestURI,ConfigDB,Entry)|body(Path,RequestURI,ConfigDB,Rest)].
+
+format(Path,RequestURI,ConfigDB,Entry) ->
+ case file:read_file_info(Path++"/"++Entry) of
+ {ok,FileInfo} when FileInfo#file_info.type == directory ->
+ {{Year,Month,Day},{Hour,Minute,Second}}=FileInfo#file_info.mtime,
+ EntryLength=length(Entry),
+ if
+ EntryLength > 21 ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> <A HREF=\"~s\">~-21.s..</A>~2.2.0w-~s-~w ~2.2.0w:~2.2.0w -\n",
+ [icon(folder),"DIR",RequestURI++"/"++Entry++"/",Entry,
+ Day,httpd_util:month(Month),Year,Hour,Minute]);
+ true ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> <A HREF=\"~s\">~s</A>~*.*c~2.2.0w-~s-~w ~2.2.0w:~2.2.0w -\n",
+ [icon(folder),"DIR",RequestURI++"/"++Entry++"/",Entry,
+ 23-EntryLength,23-EntryLength,$ ,Day,
+ httpd_util:month(Month),Year,Hour,Minute])
+ end;
+ {ok,FileInfo} ->
+ {{Year,Month,Day},{Hour,Minute,Second}}=FileInfo#file_info.mtime,
+ Suffix=httpd_util:suffix(Entry),
+ MimeType=httpd_util:lookup_mime(ConfigDB,Suffix,""),
+ EntryLength=length(Entry),
+ if
+ EntryLength > 21 ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> <A HREF=\"~s\">~-21.s..</A>~2.2.0w-~s-~w ~2.2.0w:~2.2.0w~8wk ~s\n",
+ [icon(Suffix,MimeType),Suffix,RequestURI++"/"++Entry,
+ Entry,Day,httpd_util:month(Month),Year,Hour,Minute,
+ trunc(FileInfo#file_info.size/1024+1),MimeType]);
+ true ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> <A HREF=\"~s\">~s</A>~*.*c~2.2.0w-~s-~w ~2.2.0w:~2.2.0w~8wk ~s\n",
+ [icon(Suffix,MimeType),Suffix,RequestURI++"/"++Entry,
+ Entry,23-EntryLength,23-EntryLength,$ ,Day,
+ httpd_util:month(Month),Year,Hour,Minute,
+ trunc(FileInfo#file_info.size/1024+1),MimeType])
+ end;
+ {error,Reason} ->
+ ""
+ end.
+
+%% footer
+
+footer(Path,FileList) ->
+ case lists:member("README",FileList) of
+ true ->
+ {ok,Body}=file:read_file(Path++"/README"),
+ "</PRE>\n<HR>\n<PRE>\n"++binary_to_list(Body)++
+ "\n</PRE>\n</BODY>\n</HTML>\n";
+ false ->
+ "</PRE>\n</BODY>\n</HTML>\n"
+ end.
+
+%%
+%% Icon mappings are hard-wired ala default Apache (Ugly!)
+%%
+
+icon(Suffix,MimeType) ->
+ case icon(Suffix) of
+ undefined ->
+ case MimeType of
+ [$t,$e,$x,$t,$/|_] ->
+ "/icons/text.gif";
+ [$i,$m,$a,$g,$e,$/|_] ->
+ "/icons/image2.gif";
+ [$a,$u,$d,$i,$o,$/|_] ->
+ "/icons/sound2.gif";
+ [$v,$i,$d,$e,$o,$/|_] ->
+ "/icons/movie.gif";
+ _ ->
+ "/icons/unknown.gif"
+ end;
+ Icon ->
+ Icon
+ end.
+
+icon(blank) -> "/icons/blank.gif";
+icon(back) -> "/icons/back.gif";
+icon(folder) -> "/icons/folder.gif";
+icon("bin") -> "/icons/binary.gif";
+icon("exe") -> "/icons/binary.gif";
+icon("hqx") -> "/icons/binhex.gif";
+icon("tar") -> "/icons/tar.gif";
+icon("wrl") -> "/icons/world2.gif";
+icon("wrl.gz") -> "/icons/world2.gif";
+icon("vrml") -> "/icons/world2.gif";
+icon("vrm") -> "/icons/world2.gif";
+icon("iv") -> "/icons/world2.gif";
+icon("Z") -> "/icons/compressed.gif";
+icon("z") -> "/icons/compressed.gif";
+icon("tgz") -> "/icons/compressed.gif";
+icon("gz") -> "/icons/compressed.gif";
+icon("zip") -> "/icons/compressed.gif";
+icon("ps") -> "/icons/a.gif";
+icon("ai") -> "/icons/a.gif";
+icon("eps") -> "/icons/a.gif";
+icon("html") -> "/icons/layout.gif";
+icon("shtml") -> "/icons/layout.gif";
+icon("htm") -> "/icons/layout.gif";
+icon("pdf") -> "/icons/layout.gif";
+icon("txt") -> "/icons/text.gif";
+icon("erl") -> "/icons/burst.gif";
+icon("c") -> "/icons/c.gif";
+icon("pl") -> "/icons/p.gif";
+icon("py") -> "/icons/p.gif";
+icon("for") -> "/icons/f.gif";
+icon("dvi") -> "/icons/dvi.gif";
+icon("uu") -> "/icons/uuencoded.gif";
+icon("conf") -> "/icons/script.gif";
+icon("sh") -> "/icons/script.gif";
+icon("shar") -> "/icons/script.gif";
+icon("csh") -> "/icons/script.gif";
+icon("ksh") -> "/icons/script.gif";
+icon("tcl") -> "/icons/script.gif";
+icon("tex") -> "/icons/tex.gif";
+icon("core") -> "/icons/tex.gif";
+icon(_) -> undefined.
+
+
+read_file_info_error(eacces,Info,Path) ->
+ read_file_info_error(403,Info,Path,
+ ": Missing search permissions for one "
+ "of the parent directories");
+read_file_info_error(enoent,Info,Path) ->
+ read_file_info_error(404,Info,Path,"");
+read_file_info_error(enotdir,Info,Path) ->
+ read_file_info_error(404,Info,Path,
+ ": A component of the file name is not a directory");
+read_file_info_error(_,Info,Path) ->
+ read_file_info_error(500,none,Path,"").
+
+read_file_info_error(StatusCode,none,Path,Reason) ->
+ {StatusCode,none,?NICE("Can't access "++Path++Reason)};
+read_file_info_error(StatusCode,Info,Path,Reason) ->
+ {StatusCode,Info#mod.request_uri,
+ ?NICE("Can't access "++Path++Reason)}.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_disk_log.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_disk_log.erl
new file mode 100644
index 0000000000..c5d110ee4b
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_disk_log.erl
@@ -0,0 +1,405 @@
+%% ``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_disk_log.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_disk_log).
+-export([do/1,error_log/5,security_log/2,load/2,store/2,remove/1]).
+
+-export([report_error/2]).
+
+-define(VMODULE,"DISK_LOG").
+-include("httpd_verbosity.hrl").
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ AuthUser = auth_user(Info#mod.data),
+ Date = custom_date(),
+ log_internal_info(Info,Date,Info#mod.data),
+ LogFormat = get_log_format(Info#mod.config_db),
+ case httpd_util:key1search(Info#mod.data,status) of
+ %% A status code has been generated!
+ {StatusCode,PhraseArgs,Reason} ->
+ transfer_log(Info, "-", AuthUser, Date, StatusCode, 0, LogFormat),
+ if
+ StatusCode >= 400 ->
+ error_log(Info, Date, Reason, LogFormat);
+ true ->
+ not_an_error
+ end,
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ {already_sent,StatusCode,Size} ->
+ transfer_log(Info, "-", AuthUser, Date, StatusCode,
+ Size, LogFormat),
+ {proceed,Info#mod.data};
+
+ {response, Head, Body} ->
+ Size = httpd_util:key1search(Head, content_length, 0),
+ Code = httpd_util:key1search(Head, code, 200),
+ transfer_log(Info, "-", AuthUser, Date, Code,
+ Size, LogFormat),
+ {proceed,Info#mod.data};
+
+ {StatusCode,Response} ->
+ transfer_log(Info, "-", AuthUser, Date, 200,
+ httpd_util:flatlength(Response), LogFormat),
+ {proceed,Info#mod.data};
+ undefined ->
+ transfer_log(Info, "-", AuthUser, Date, 200,
+ 0, LogFormat),
+ {proceed,Info#mod.data}
+ end
+ end.
+
+custom_date() ->
+ LocalTime = calendar:local_time(),
+ UniversalTime = calendar:universal_time(),
+ Minutes = round(diff_in_minutes(LocalTime,UniversalTime)),
+ {{YYYY,MM,DD},{Hour,Min,Sec}} = LocalTime,
+ Date =
+ io_lib:format("~.2.0w/~.3s/~.4w:~.2.0w:~.2.0w:~.2.0w ~c~.2.0w~.2.0w",
+ [DD,httpd_util:month(MM),YYYY,Hour,Min,Sec,sign(Minutes),
+ abs(Minutes) div 60,abs(Minutes) rem 60]),
+ lists:flatten(Date).
+
+diff_in_minutes(L,U) ->
+ (calendar:datetime_to_gregorian_seconds(L) -
+ calendar:datetime_to_gregorian_seconds(U))/60.
+
+sign(Minutes) when Minutes > 0 ->
+ $+;
+sign(Minutes) ->
+ $-.
+
+auth_user(Data) ->
+ case httpd_util:key1search(Data,remote_user) of
+ undefined ->
+ "-";
+ RemoteUser ->
+ RemoteUser
+ end.
+
+%% log_internal_info
+
+log_internal_info(Info,Date,[]) ->
+ ok;
+log_internal_info(Info,Date,[{internal_info,Reason}|Rest]) ->
+ Format = get_log_format(Info#mod.config_db),
+ error_log(Info,Date,Reason,Format),
+ log_internal_info(Info,Date,Rest);
+log_internal_info(Info,Date,[_|Rest]) ->
+ log_internal_info(Info,Date,Rest).
+
+
+%% transfer_log
+
+transfer_log(Info,RFC931,AuthUser,Date,StatusCode,Bytes,Format) ->
+ case httpd_util:lookup(Info#mod.config_db,transfer_disk_log) of
+ undefined ->
+ no_transfer_log;
+ TransferDiskLog ->
+ {PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+ Entry = io_lib:format("~s ~s ~s [~s] \"~s\" ~w ~w~n",
+ [RemoteHost,RFC931,AuthUser,Date,
+ Info#mod.request_line,StatusCode,Bytes]),
+ write(TransferDiskLog, Entry, Format)
+ end.
+
+
+%% error_log
+
+error_log(Info, Date, Reason, Format) ->
+ Format=get_log_format(Info#mod.config_db),
+ case httpd_util:lookup(Info#mod.config_db,error_disk_log) of
+ undefined ->
+ no_error_log;
+ ErrorDiskLog ->
+ {PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+ Entry =
+ io_lib:format("[~s] access to ~s failed for ~s, reason: ~p~n",
+ [Date, Info#mod.request_uri,
+ RemoteHost, Reason]),
+ write(ErrorDiskLog, Entry, Format)
+ end.
+
+error_log(SocketType, Socket, ConfigDB, {PortNumber, RemoteHost}, Reason) ->
+ Format = get_log_format(ConfigDB),
+ case httpd_util:lookup(ConfigDB,error_disk_log) of
+ undefined ->
+ no_error_log;
+ ErrorDiskLog ->
+ Date = custom_date(),
+ Entry =
+ io_lib:format("[~s] server crash for ~s, reason: ~p~n",
+ [Date,RemoteHost,Reason]),
+ write(ErrorDiskLog, Entry, Format),
+ ok
+ end.
+
+
+%% security_log
+
+security_log(ConfigDB, Event) ->
+ Format = get_log_format(ConfigDB),
+ case httpd_util:lookup(ConfigDB,security_disk_log) of
+ undefined ->
+ no_error_log;
+ DiskLog ->
+ Date = custom_date(),
+ Entry = io_lib:format("[~s] ~s ~n", [Date, Event]),
+ write(DiskLog, Entry, Format),
+ ok
+ end.
+
+report_error(ConfigDB, Error) ->
+ Format = get_log_format(ConfigDB),
+ case httpd_util:lookup(ConfigDB, error_disk_log) of
+ undefined ->
+ no_error_log;
+ ErrorDiskLog ->
+ Date = custom_date(),
+ Entry = io_lib:format("[~s] reporting error: ~s",[Date,Error]),
+ write(ErrorDiskLog, Entry, Format),
+ ok
+ end.
+
+%%----------------------------------------------------------------------
+%% Get the current format of the disklog
+%%----------------------------------------------------------------------
+get_log_format(ConfigDB)->
+ httpd_util:lookup(ConfigDB,disk_log_format,external).
+
+
+%%
+%% Configuration
+%%
+
+%% load
+
+load([$T,$r,$a,$n,$s,$f,$e,$r,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ |
+ TransferDiskLogSize],[]) ->
+ case regexp:split(TransferDiskLogSize," ") of
+ {ok,[MaxBytes,MaxFiles]} ->
+ case httpd_conf:make_integer(MaxBytes) of
+ {ok,MaxBytesInteger} ->
+ case httpd_conf:make_integer(MaxFiles) of
+ {ok,MaxFilesInteger} ->
+ {ok,[],{transfer_disk_log_size,
+ {MaxBytesInteger,MaxFilesInteger}}};
+ {error,_} ->
+ {error,
+ ?NICE(httpd_conf:clean(TransferDiskLogSize)++
+ " is an invalid TransferDiskLogSize")}
+ end;
+ {error,_} ->
+ {error,?NICE(httpd_conf:clean(TransferDiskLogSize)++
+ " is an invalid TransferDiskLogSize")}
+ end
+ end;
+load([$T,$r,$a,$n,$s,$f,$e,$r,$D,$i,$s,$k,$L,$o,$g,$ |TransferDiskLog],[]) ->
+ {ok,[],{transfer_disk_log,httpd_conf:clean(TransferDiskLog)}};
+
+load([$E,$r,$r,$o,$r,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ | ErrorDiskLogSize],[]) ->
+ case regexp:split(ErrorDiskLogSize," ") of
+ {ok,[MaxBytes,MaxFiles]} ->
+ case httpd_conf:make_integer(MaxBytes) of
+ {ok,MaxBytesInteger} ->
+ case httpd_conf:make_integer(MaxFiles) of
+ {ok,MaxFilesInteger} ->
+ {ok,[],{error_disk_log_size,
+ {MaxBytesInteger,MaxFilesInteger}}};
+ {error,_} ->
+ {error,?NICE(httpd_conf:clean(ErrorDiskLogSize)++
+ " is an invalid ErrorDiskLogSize")}
+ end;
+ {error,_} ->
+ {error,?NICE(httpd_conf:clean(ErrorDiskLogSize)++
+ " is an invalid ErrorDiskLogSize")}
+ end
+ end;
+load([$E,$r,$r,$o,$r,$D,$i,$s,$k,$L,$o,$g,$ |ErrorDiskLog],[]) ->
+ {ok, [], {error_disk_log, httpd_conf:clean(ErrorDiskLog)}};
+
+load([$S,$e,$c,$u,$r,$i,$t,$y,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ |SecurityDiskLogSize],[]) ->
+ case regexp:split(SecurityDiskLogSize, " ") of
+ {ok, [MaxBytes, MaxFiles]} ->
+ case httpd_conf:make_integer(MaxBytes) of
+ {ok, MaxBytesInteger} ->
+ case httpd_conf:make_integer(MaxFiles) of
+ {ok, MaxFilesInteger} ->
+ {ok, [], {security_disk_log_size,
+ {MaxBytesInteger, MaxFilesInteger}}};
+ {error,_} ->
+ {error, ?NICE(httpd_conf:clean(SecurityDiskLogSize)++
+ " is an invalid SecurityDiskLogSize")}
+ end;
+ {error, _} ->
+ {error, ?NICE(httpd_conf:clean(SecurityDiskLogSize)++
+ " is an invalid SecurityDiskLogSize")}
+ end
+ end;
+load([$S,$e,$c,$u,$r,$i,$t,$y,$D,$i,$s,$k,$L,$o,$g,$ |SecurityDiskLog],[]) ->
+ {ok, [], {security_disk_log, httpd_conf:clean(SecurityDiskLog)}};
+
+load([$D,$i,$s,$k,$L,$o,$g,$F,$o,$r,$m,$a,$t,$ |Format],[]) ->
+ case httpd_conf:clean(Format) of
+ "internal" ->
+ {ok, [], {disk_log_format,internal}};
+ "external" ->
+ {ok, [], {disk_log_format,external}};
+ _Default ->
+ {ok, [], {disk_log_format,external}}
+ end.
+
+%% store
+
+store({transfer_disk_log,TransferDiskLog},ConfigList) ->
+ case create_disk_log(TransferDiskLog, transfer_disk_log_size, ConfigList) of
+ {ok,TransferDB} ->
+ {ok,{transfer_disk_log,TransferDB}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({security_disk_log,SecurityDiskLog},ConfigList) ->
+ case create_disk_log(SecurityDiskLog, security_disk_log_size, ConfigList) of
+ {ok,SecurityDB} ->
+ {ok,{security_disk_log,SecurityDB}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({error_disk_log,ErrorDiskLog},ConfigList) ->
+ case create_disk_log(ErrorDiskLog, error_disk_log_size, ConfigList) of
+ {ok,ErrorDB} ->
+ {ok,{error_disk_log,ErrorDB}};
+ {error,Reason} ->
+ {error,Reason}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Open or creates the disklogs
+%%----------------------------------------------------------------------
+log_size(ConfigList, Tag) ->
+ httpd_util:key1search(ConfigList, Tag, {500*1024,8}).
+
+create_disk_log(LogFile, SizeTag, ConfigList) ->
+ Filename = httpd_conf:clean(LogFile),
+ {MaxBytes, MaxFiles} = log_size(ConfigList, SizeTag),
+ case filename:pathtype(Filename) of
+ absolute ->
+ create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList);
+ volumerelative ->
+ create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList);
+ relative ->
+ case httpd_util:key1search(ConfigList,server_root) of
+ undefined ->
+ {error,
+ ?NICE(Filename++
+ " is an invalid ErrorLog beacuse ServerRoot is not defined")};
+ ServerRoot ->
+ AbsoluteFilename = filename:join(ServerRoot,Filename),
+ create_disk_log(AbsoluteFilename, MaxBytes, MaxFiles,
+ ConfigList)
+ end
+ end.
+
+create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList) ->
+ Format = httpd_util:key1search(ConfigList, disk_log_format, external),
+ open(Filename, MaxBytes, MaxFiles, Format).
+
+
+
+%% remove
+remove(ConfigDB) ->
+ lists:foreach(fun([DiskLog]) -> close(DiskLog) end,
+ ets:match(ConfigDB,{transfer_disk_log,'$1'})),
+ lists:foreach(fun([DiskLog]) -> close(DiskLog) end,
+ ets:match(ConfigDB,{error_disk_log,'$1'})),
+ ok.
+
+
+%%
+%% Some disk_log wrapper functions:
+%%
+
+%%----------------------------------------------------------------------
+%% Function: open/4
+%% Description: Open a disk log file.
+%% Control which format the disk log will be in. The external file
+%% format is used as default since that format was used by older
+%% implementations of inets.
+%%
+%% When the internal disk log format is used, we will do some extra
+%% controls. If the files are valid, try to repair them and if
+%% thats not possible, truncate.
+%%----------------------------------------------------------------------
+
+open(Filename, MaxBytes, MaxFiles, internal) ->
+ Opts = [{format, internal}, {repair, truncate}],
+ open1(Filename, MaxBytes, MaxFiles, Opts);
+open(Filename, MaxBytes, MaxFiles, _) ->
+ Opts = [{format, external}],
+ open1(Filename, MaxBytes, MaxFiles, Opts).
+
+open1(Filename, MaxBytes, MaxFiles, Opts0) ->
+ Opts1 = [{name, Filename}, {file, Filename}, {type, wrap}] ++ Opts0,
+ case open2(Opts1, {MaxBytes, MaxFiles}) of
+ {ok, LogDB} ->
+ {ok, LogDB};
+ {error, Reason} ->
+ ?vlog("failed opening disk log with args:"
+ "~n Filename: ~p"
+ "~n MaxBytes: ~p"
+ "~n MaxFiles: ~p"
+ "~n Opts0: ~p"
+ "~nfor reason:"
+ "~n ~p", [Filename, MaxBytes, MaxFiles, Opts0, Reason]),
+ {error,
+ ?NICE("Can't create " ++ Filename ++
+ lists:flatten(io_lib:format(", ~p",[Reason])))};
+ _ ->
+ {error, ?NICE("Can't create "++Filename)}
+ end.
+
+open2(Opts, Size) ->
+ case disk_log:open(Opts) of
+ {error, {badarg, size}} ->
+ %% File did not exist, add the size option and try again
+ disk_log:open([{size, Size} | Opts]);
+ Else ->
+ Else
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Actually writes the entry to the disk_log. If the log is an
+%% internal disk_log write it with log otherwise with blog.
+%%----------------------------------------------------------------------
+write(Log, Entry, internal) ->
+ disk_log:log(Log, Entry);
+
+write(Log, Entry, _) ->
+ disk_log:blog(Log, Entry).
+
+%% Close the log file
+close(Log) ->
+ disk_log:close(Log).
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl
new file mode 100644
index 0000000000..d527f36788
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl
@@ -0,0 +1,490 @@
+%% ``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_esi.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_esi).
+-export([do/1,load/2]).
+
+%%Functions provided to help erl scheme alias programmer to
+%%Create dynamic webpages that are sent back to the user during
+%%Generation
+-export([deliver/2]).
+
+
+-include("httpd.hrl").
+
+-define(VMODULE,"ESI").
+-include("httpd_verbosity.hrl").
+
+-define(GATEWAY_INTERFACE,"CGI/1.1").
+-define(DEFAULT_ERL_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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ case erl_or_eval(Info#mod.request_uri,
+ Info#mod.config_db) of
+ {eval,CGIBody,Modules} ->
+ eval(Info,Info#mod.method,CGIBody,Modules);
+ {erl,CGIBody,Modules} ->
+ erl(Info,Info#mod.method,CGIBody,Modules);
+ proceed ->
+ {proceed,Info#mod.data}
+ end;
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end.
+
+
+
+%% erl_or_eval
+
+erl_or_eval(RequestURI, ConfigDB) ->
+ case erlp(RequestURI, ConfigDB) of
+ false ->
+ case evalp(RequestURI, ConfigDB) of
+ false ->
+ ?vtrace("neither erl nor eval",[]),
+ proceed;
+ Other ->
+ Other
+ end;
+ Other ->
+ Other
+ end.
+
+erlp(RequestURI, ConfigDB) ->
+ case httpd_util:multi_lookup(ConfigDB, erl_script_alias) of
+ [] ->
+ false;
+ AliasMods ->
+ erlp_find_alias(RequestURI,AliasMods)
+ end.
+
+erlp_find_alias(_RequestURI,[]) ->
+ ?vtrace("erlp_find_alias -> no match",[]),
+ false;
+erlp_find_alias(RequestURI,[{Alias,Modules}|Rest]) ->
+ case regexp:first_match(RequestURI,"^"++Alias++"/") of
+ {match,1,Length} ->
+ ?vtrace("erlp -> match with Length: ~p",[Length]),
+ {erl,string:substr(RequestURI,Length+1),Modules};
+ nomatch ->
+ erlp_find_alias(RequestURI,Rest)
+ end.
+
+evalp(RequestURI, ConfigDB) ->
+ case httpd_util:multi_lookup(ConfigDB, eval_script_alias) of
+ [] ->
+ false;
+ AliasMods ->
+ evalp_find_alias(RequestURI,AliasMods)
+ end.
+
+evalp_find_alias(_RequestURI,[]) ->
+ ?vtrace("evalp_find_alias -> no match",[]),
+ false;
+evalp_find_alias(RequestURI,[{Alias,Modules}|Rest]) ->
+ case regexp:first_match(RequestURI,"^"++Alias++"\\?") of
+ {match, 1, Length} ->
+ ?vtrace("evalp_find_alias -> match with Length: ~p",[Length]),
+ {eval, string:substr(RequestURI,Length+1),Modules};
+ nomatch ->
+ evalp_find_alias(RequestURI,Rest)
+ end.
+
+
+%%
+%% Erl mechanism
+%%
+
+%%This is exactly the same as the GET method the difference is that
+%%The response must not contain any data expect the response header
+
+
+erl(Info,"HEAD",CGIBody,Modules) ->
+ erl(Info,"GET",CGIBody,Modules);
+
+erl(Info,"GET",CGIBody,Modules) ->
+ ?vtrace("erl GET request",[]),
+ case httpd_util:split(CGIBody,":|%3A|/",2) of
+ {ok, [Mod,FuncAndInput]} ->
+ ?vtrace("~n Mod: ~p"
+ "~n FuncAndInput: ~p",[Mod,FuncAndInput]),
+ case httpd_util:split(FuncAndInput,"[\?/]",2) of
+ {ok, [Func,Input]} ->
+ ?vtrace("~n Func: ~p"
+ "~n Input: ~p",[Func,Input]),
+ exec(Info,"GET",CGIBody,Modules,Mod,Func,
+ {input_type(FuncAndInput),Input});
+ {ok, [Func]} ->
+ exec(Info,"GET",CGIBody,Modules,Mod,Func,{no_input,""});
+ {ok, BadRequest} ->
+ {proceed,[{status,{400,none,BadRequest}}|Info#mod.data]}
+ end;
+ {ok, BadRequest} ->
+ ?vlog("erl BAD (GET-) request",[]),
+ {proceed, [{status,{400,none,BadRequest}}|Info#mod.data]}
+ end;
+
+erl(Info, "POST", CGIBody, Modules) ->
+ ?vtrace("erl POST request",[]),
+ case httpd_util:split(CGIBody,":|%3A|/",2) of
+ {ok,[Mod,Func]} ->
+ ?vtrace("~n Mod: ~p"
+ "~n Func: ~p",[Mod,Func]),
+ exec(Info,"POST",CGIBody,Modules,Mod,Func,
+ {entity_body,Info#mod.entity_body});
+ {ok,BadRequest} ->
+ ?vlog("erl BAD (POST-) request",[]),
+ {proceed,[{status,{400,none,BadRequest}}|Info#mod.data]}
+ end.
+
+input_type([]) ->
+ no_input;
+input_type([$/|Rest]) ->
+ path_info;
+input_type([$?|Rest]) ->
+ query_string;
+input_type([First|Rest]) ->
+ input_type(Rest).
+
+
+%% exec
+
+exec(Info,Method,CGIBody,["all"],Mod,Func,{Type,Input}) ->
+ ?vtrace("exec ~s 'all'",[Method]),
+ exec(Info,Method,CGIBody,[Mod],Mod,Func,{Type,Input});
+exec(Info,Method,CGIBody,Modules,Mod,Func,{Type,Input}) ->
+ ?vtrace("exec ~s request with:"
+ "~n Modules: ~p"
+ "~n Mod: ~p"
+ "~n Func: ~p"
+ "~n Type: ~p"
+ "~n Input: ~p",
+ [Method,Modules,Mod,Func,Type,Input]),
+ case lists:member(Mod,Modules) of
+ true ->
+ {_,RemoteAddr}=(Info#mod.init_data)#init_data.peername,
+ ServerName=(Info#mod.init_data)#init_data.resolve,
+ Env=get_environment(Info,ServerName,Method,RemoteAddr,Type,Input),
+ ?vtrace("and now call the module",[]),
+ case try_new_erl_scheme_method(Info,Env,Input,list_to_atom(Mod),list_to_atom(Func)) of
+ {error,not_new_method}->
+ case catch apply(list_to_atom(Mod),list_to_atom(Func),[Env,Input]) of
+ {'EXIT',Reason} ->
+ ?vlog("exit with Reason: ~p",[Reason]),
+ {proceed,[{status,{500,none,Reason}}|Info#mod.data]};
+ Response ->
+ control_response_header(Info,Mod,Func,Response)
+ end;
+ ResponseResult->
+ ResponseResult
+ end;
+ false ->
+ ?vlog("unknown module",[]),
+ {proceed,[{status,{403,Info#mod.request_uri,
+ ?NICE("Client not authorized to evaluate: "++CGIBody)}}|Info#mod.data]}
+ end.
+
+control_response_header(Info,Mod,Func,Response)->
+ case control_response(Response,Info,Mod,Func) of
+ {proceed,[{response,{StatusCode,Response}}|Rest]} ->
+ case httpd_util:lookup(Info#mod.config_db,erl_script_nocache,false) of
+ true ->
+ case httpd_util:split(Response,"\r\n\r\n|\n\n",2) of
+ {ok,[Head,Body]}->
+ Date=httpd_util:rfc1123_date(),
+ Cache="Cache-Control:no-cache\r\nPragma:no-cache\r\nExpires:"++ Date ++ "\r\n",
+ {proceed,[{response,{StatusCode,[Head,"\r\n",Cache,"\r\n",Body]}}|Rest]};
+ _->
+ {proceed,[{response,{StatusCode,Response}}|Rest]}
+ end;
+ WhatEver->
+ {proceed,[{response,{StatusCode,Response}}|Rest]}
+ end;
+ WhatEver->
+ WhatEver
+ end.
+
+control_response(Response,Info,Mod,Func)->
+ ?vdebug("Response: ~n~p",[Response]),
+ case mod_cgi:status_code(lists:flatten(Response)) of
+ {ok,StatusCode} ->
+ {proceed,[{response,{StatusCode,Response}}|Info#mod.data]};
+ {error,Reason} ->
+ {proceed,
+ [{status,{400,none,
+ ?NICE("Error in "++Mod++":"++Func++"/2: "++
+ lists:flatten(io_lib:format("~p",[Reason])))}}|
+ Info#mod.data]}
+ end.
+
+parsed_header([]) ->
+ [];
+parsed_header([{Name,[Value|R1]}|R2]) when list(Value) ->
+ NewName=lists:map(fun(X) -> if X == $- -> $_; true -> X end end,Name),
+ [{list_to_atom("http_"++httpd_util:to_lower(NewName)),
+ multi_value([Value|R1])}|parsed_header(R2)];
+parsed_header([{Name,Value}|Rest]) when list(Value)->
+ {ok,NewName,_}=regexp:gsub(Name,"-","_"),
+ [{list_to_atom("http_"++httpd_util:to_lower(NewName)),Value}|
+ parsed_header(Rest)].
+
+multi_value([]) ->
+ [];
+multi_value([Value]) ->
+ Value;
+multi_value([Value|Rest]) ->
+ Value++", "++multi_value(Rest).
+
+%%
+%% Eval mechanism
+%%
+
+
+eval(Info,"POST",CGIBody,Modules) ->
+ ?vtrace("eval(POST) -> method not supported",[]),
+ {proceed,[{status,{501,{"POST",Info#mod.request_uri,Info#mod.http_version},
+ ?NICE("Eval mechanism doesn't support method POST")}}|
+ Info#mod.data]};
+
+eval(Info,"HEAD",CGIBody,Modules) ->
+ %%The function that sends the data in httpd_response handles HEAD reqest by not
+ %% Sending the body
+ eval(Info,"GET",CGIBody,Modules);
+
+
+eval(Info,"GET",CGIBody,Modules) ->
+ ?vtrace("eval(GET) -> entry when"
+ "~n Modules: ~p",[Modules]),
+ case auth(CGIBody,Modules) of
+ true ->
+ case lib:eval_str(string:concat(CGIBody,". ")) of
+ {error,Reason} ->
+ ?vlog("eval -> error:"
+ "~n Reason: ~p",[Reason]),
+ {proceed,[{status,{500,none,Reason}}|Info#mod.data]};
+ {ok,Response} ->
+ ?vtrace("eval -> ok:"
+ "~n Response: ~p",[Response]),
+ case mod_cgi:status_code(lists:flatten(Response)) of
+ {ok,StatusCode} ->
+ {proceed,[{response,{StatusCode,Response}}|Info#mod.data]};
+ {error,Reason} ->
+ {proceed,[{status,{400,none,Reason}}|Info#mod.data]}
+ end
+ end;
+ false ->
+ ?vlog("eval -> auth failed",[]),
+ {proceed,[{status,
+ {403,Info#mod.request_uri,
+ ?NICE("Client not authorized to evaluate: "++CGIBody)}}|
+ Info#mod.data]}
+ end.
+
+auth(CGIBody,["all"]) ->
+ true;
+auth(CGIBody,Modules) ->
+ case regexp:match(CGIBody,"^[^\:(%3A)]*") of
+ {match,Start,Length} ->
+ lists:member(string:substr(CGIBody,Start,Length),Modules);
+ nomatch ->
+ false
+ end.
+
+%%----------------------------------------------------------------------
+%%Creates the environment list that will be the first arg to the
+%%Functions that is called through the ErlScript Schema
+%%----------------------------------------------------------------------
+
+get_environment(Info,ServerName,Method,RemoteAddr,Type,Input)->
+ Env=[{server_software,?SERVER_SOFTWARE},
+ {server_name,ServerName},
+ {gateway_interface,?GATEWAY_INTERFACE},
+ {server_protocol,?SERVER_PROTOCOL},
+ {server_port,httpd_util:lookup(Info#mod.config_db,port,80)},
+ {request_method,Method},
+ {remote_addr,RemoteAddr},
+ {script_name,Info#mod.request_uri}|
+ parsed_header(Info#mod.parsed_header)],
+ get_environment(Type,Input,Env,Info).
+
+
+get_environment(Type,Input,Env,Info)->
+ Env1=case Type of
+ query_string ->
+ [{query_string,Input}|Env];
+ path_info ->
+ Aliases=httpd_util:multi_lookup(Info#mod.config_db,alias),
+ {_,PathTranslated,_}=mod_alias:real_name(Info#mod.config_db,[$/|Input],Aliases),
+ [{path_info,"/"++httpd_util:decode_hex(Input)},
+ {path_translated,PathTranslated}|Env];
+ entity_body ->
+ [{content_length,httpd_util:flatlength(Input)}|Env];
+ no_input ->
+ Env
+ end,
+ get_environment(Info,Env1).
+
+get_environment(Info,Env)->
+ case httpd_util:key1search(Info#mod.data,remote_user) of
+ undefined ->
+ Env;
+ RemoteUser ->
+ [{remote_user,RemoteUser}|Env]
+ end.
+%%
+%% Configuration
+%%
+
+%% load
+
+load([$E,$r,$l,$S,$c,$r,$i,$p,$t,$A,$l,$i,$a,$s,$ |ErlScriptAlias],[]) ->
+ case regexp:split(ErlScriptAlias," ") of
+ {ok, [ErlName|Modules]} ->
+ {ok, [], {erl_script_alias, {ErlName,Modules}}};
+ {ok, _} ->
+ {error,?NICE(httpd_conf:clean(ErlScriptAlias)++
+ " is an invalid ErlScriptAlias")}
+ end;
+load([$E,$v,$a,$l,$S,$c,$r,$i,$p,$t,$A,$l,$i,$a,$s,$ |EvalScriptAlias],[]) ->
+ case regexp:split(EvalScriptAlias, " ") of
+ {ok, [EvalName|Modules]} ->
+ {ok, [], {eval_script_alias, {EvalName,Modules}}};
+ {ok, _} ->
+ {error, ?NICE(httpd_conf:clean(EvalScriptAlias)++
+ " is an invalid EvalScriptAlias")}
+ end;
+load([$E,$r,$l,$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, [], {erl_script_timeout,TimeoutSec*1000}};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(Timeout)++
+ " is an invalid ErlScriptTimeout")}
+ end;
+load([$E,$r,$l,$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, [], {erl_script_nocache,true}};
+ false ->
+ {ok, [], {erl_script_nocache,false}};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(CacheArg)++
+ " is an invalid ErlScriptNoCache directive")}
+ end.
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Functions below handles the data from the dynamic webpages %%
+%% That sends data back to the user part by part %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%----------------------------------------------------------------------
+%%Deliver is the callback function users can call to deliver back data to the
+%%client
+%%----------------------------------------------------------------------
+
+deliver(SessionID,Data)when pid(SessionID) ->
+ SessionID ! {ok,Data},
+ ok;
+deliver(SessionID,Data) ->
+ {error,bad_sessionID}.
+
+
+%%----------------------------------------------------------------------
+%% The method that tries to execute the new format
+%%----------------------------------------------------------------------
+
+%%It would be nicer to use erlang:function_exported/3 but if the
+%%Module isn't loaded the function says that it is not loaded
+
+
+try_new_erl_scheme_method(Info,Env,Input,Mod,Func)->
+ process_flag(trap_exit,true),
+ Pid=spawn_link(Mod,Func,[self(),Env,Input]),
+ Timeout=httpd_util:lookup(Info#mod.config_db,erl_script_timeout,?DEFAULT_ERL_TIMEOUT),
+ RetVal=receive_response_data(Info,Pid,0,undefined,[],Timeout),
+ process_flag(trap_exit,false),
+ RetVal.
+
+
+%%----------------------------------------------------------------------
+%%The function recieves the data from the process that generates the page
+%%and send the data to the client through the mod_cgi:send function
+%%----------------------------------------------------------------------
+
+receive_response_data(Info,Pid,Size,StatusCode,AccResponse,Timeout) ->
+ ?DEBUG("receive_response_data()-> Script Size: ~p,StatusCode ~p ,Timeout: ~p ~n",[Size,StatusCode,Timeout]),
+ receive
+ {ok, Response} ->
+ NewStatusCode=mod_cgi:update_status_code(StatusCode,Response),
+
+ ?DEBUG("receive_response_data/2 NewStatusCode: ~p~n",[NewStatusCode]),
+ case mod_cgi:send(Info, NewStatusCode,Response, Size,AccResponse) of
+ socket_closed ->
+ (catch exit(Pid,final)),
+ {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]};
+ head_sent->
+ (catch exit(Pid,final)),
+ {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]};
+ _ ->
+ %%The data is sent and the socket is not closed contine
+ NewSize = mod_cgi:get_new_size(Size,Response),
+ receive_response_data(Info,Pid,NewSize,NewStatusCode,"notempty",Timeout)
+ end;
+ {'EXIT', Pid, Reason} when AccResponse==[] ->
+ {error,not_new_method};
+ {'EXIT', Pid, Reason} when pid(Pid) ->
+ NewStatusCode=mod_cgi:update_status_code(StatusCode,AccResponse),
+ mod_cgi:final_send(Info,NewStatusCode,Size,AccResponse),
+ {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]};
+ %% This should not happen!
+ WhatEver ->
+ NewStatusCode=mod_cgi:update_status_code(StatusCode,AccResponse),
+ mod_cgi:final_send(Info,StatusCode,Size,AccResponse),
+ {proceed, [{response,{already_sent,200,Size}}|Info#mod.data]}
+ after
+ Timeout ->
+ (catch exit(Pid,timeout)), % KILL the port !!!!
+ httpd_socket:close(Info#mod.socket_type,Info#mod.socket),
+ {proceed,[{response,{already_sent,200,Size}}|Info#mod.data]}
+ end.
+
+
+
+
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_get.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_get.erl
new file mode 100644
index 0000000000..02f708f85b
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_get.erl
@@ -0,0 +1,179 @@
+%% ``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_get.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_get).
+-export([do/1]).
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ case Info#mod.method of
+ "GET" ->
+ 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ do_get(Info);
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end;
+ %% Not a GET method!
+ _ ->
+ {proceed,Info#mod.data}
+ end.
+
+
+do_get(Info) ->
+ ?DEBUG("do_get -> Request URI: ~p",[Info#mod.request_uri]),
+ Path = mod_alias:path(Info#mod.data, Info#mod.config_db,
+ Info#mod.request_uri),
+ {FileInfo, LastModified} =get_modification_date(Path),
+
+ send_response(Info#mod.socket,Info#mod.socket_type,Path,Info,FileInfo,LastModified).
+
+
+%%The common case when no range is specified
+send_response(Socket,SocketType,Path,Info,FileInfo,LastModified)->
+ %% Send the file!
+ %% Find the modification date of the file
+ case file:open(Path,[raw,binary]) of
+ {ok, FileDescriptor} ->
+ ?DEBUG("do_get -> FileDescriptor: ~p",[FileDescriptor]),
+ Suffix = httpd_util:suffix(Path),
+ MimeType = httpd_util:lookup_mime_default(Info#mod.config_db,
+ Suffix,"text/plain"),
+ %FileInfo=file:read_file_info(Path),
+ Date = httpd_util:rfc1123_date(),
+ Size = integer_to_list(FileInfo#file_info.size),
+ Header=case Info#mod.http_version of
+ "HTTP/1.1" ->
+ [httpd_util:header(200, MimeType, Info#mod.connection),
+ "Last-Modified: ", LastModified, "\r\n",
+ "Etag: ",httpd_util:create_etag(FileInfo),"\r\n",
+ "Content-Length: ",Size,"\r\n\r\n"];
+ "HTTP/1.0" ->
+ [httpd_util:header(200, MimeType, Info#mod.connection),
+ "Last-Modified: ", LastModified, "\r\n",
+ "Content-Length: ",Size,"\r\n\r\n"]
+ end,
+
+ send(Info#mod.socket_type, Info#mod.socket,
+ Header, FileDescriptor),
+ file:close(FileDescriptor),
+ {proceed,[{response,{already_sent,200,
+ FileInfo#file_info.size}},
+ {mime_type,MimeType}|Info#mod.data]};
+ {error, Reason} ->
+
+ {proceed,
+ [{status,open_error(Reason,Info,Path)}|Info#mod.data]}
+ end.
+
+%% send
+
+send(SocketType,Socket,Header,FileDescriptor) ->
+ ?DEBUG("send -> send header",[]),
+ case httpd_socket:deliver(SocketType,Socket,Header) of
+ socket_closed ->
+ ?LOG("send -> socket closed while sending header",[]),
+ socket_close;
+ _ ->
+ send_body(SocketType,Socket,FileDescriptor)
+ end.
+
+send_body(SocketType,Socket,FileDescriptor) ->
+ case file:read(FileDescriptor,?FILE_CHUNK_SIZE) of
+ {ok,Binary} ->
+ ?DEBUG("send_body -> send another chunk: ~p",[size(Binary)]),
+ case httpd_socket:deliver(SocketType,Socket,Binary) of
+ socket_closed ->
+ ?LOG("send_body -> socket closed while sending",[]),
+ socket_close;
+ _ ->
+ send_body(SocketType,Socket,FileDescriptor)
+ end;
+ eof ->
+ ?DEBUG("send_body -> done with this file",[]),
+ eof
+ end.
+
+
+%% open_error - Handle file open failure
+%%
+open_error(eacces,Info,Path) ->
+ open_error(403,Info,Path,"");
+open_error(enoent,Info,Path) ->
+ open_error(404,Info,Path,"");
+open_error(enotdir,Info,Path) ->
+ open_error(404,Info,Path,
+ ": A component of the file name is not a directory");
+open_error(emfile,_Info,Path) ->
+ open_error(500,none,Path,": To many open files");
+open_error({enfile,_},_Info,Path) ->
+ open_error(500,none,Path,": File table overflow");
+open_error(_Reason,_Info,Path) ->
+ open_error(500,none,Path,"").
+
+open_error(StatusCode,none,Path,Reason) ->
+ {StatusCode,none,?NICE("Can't open "++Path++Reason)};
+open_error(StatusCode,Info,Path,Reason) ->
+ {StatusCode,Info#mod.request_uri,?NICE("Can't open "++Path++Reason)}.
+
+get_modification_date(Path)->
+ case file:read_file_info(Path) of
+ {ok, FileInfo0} ->
+ {FileInfo0, httpd_util:rfc1123_date(FileInfo0#file_info.mtime)};
+ _ ->
+ {#file_info{},""}
+ end.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_head.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_head.erl
new file mode 100644
index 0000000000..542604e092
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_head.erl
@@ -0,0 +1,89 @@
+%% ``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_head.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_head).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ case Info#mod.method of
+ "HEAD" ->
+ 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ do_head(Info);
+ %% A response has been sent! Nothing to do about it!
+ {already_sent,StatusCode,Size} ->
+ {proceed,Info#mod.data};
+ %% A response has been generated!
+ {StatusCode,Response} ->
+ {proceed,Info#mod.data}
+ end
+ end;
+ %% Not a HEAD method!
+ _ ->
+ {proceed,Info#mod.data}
+ end.
+
+do_head(Info) ->
+ ?DEBUG("do_head -> Request URI: ~p",[Info#mod.request_uri]),
+ Path = mod_alias:path(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri),
+ Suffix = httpd_util:suffix(Path),
+ %% Does the file exists?
+ case file:read_file_info(Path) of
+ {ok,FileInfo} ->
+ MimeType=httpd_util:lookup_mime_default(Info#mod.config_db,Suffix,"text/plain"),
+ Length=io_lib:write(FileInfo#file_info.size),
+ Head=[{content_type,MimeType},{content_length,Length},{code,200}],
+ {proceed,[{response,{response,Head,nobody}}|Info#mod.data]};
+ {error,Reason} ->
+ {proceed,
+ [{status,read_file_info_error(Reason,Info,Path)}|Info#mod.data]}
+ end.
+
+%% read_file_info_error - Handle file info read failure
+%%
+read_file_info_error(eacces,Info,Path) ->
+ read_file_info_error(403,Info,Path,"");
+read_file_info_error(enoent,Info,Path) ->
+ read_file_info_error(404,Info,Path,"");
+read_file_info_error(enotdir,Info,Path) ->
+ read_file_info_error(404,Info,Path,
+ ": A component of the file name is not a directory");
+read_file_info_error(emfile,_Info,Path) ->
+ read_file_info_error(500,none,Path,": To many open files");
+read_file_info_error({enfile,_},_Info,Path) ->
+ read_file_info_error(500,none,Path,": File table overflow");
+read_file_info_error(_Reason,_Info,Path) ->
+ read_file_info_error(500,none,Path,"").
+
+read_file_info_error(StatusCode,none,Path,Reason) ->
+ {StatusCode,none,?NICE("Can't access "++Path++Reason)};
+read_file_info_error(StatusCode,Info,Path,Reason) ->
+ {StatusCode,Info#mod.request_uri,
+ ?NICE("Can't access "++Path++Reason)}.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_htaccess.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_htaccess.erl
new file mode 100644
index 0000000000..069e4ad3a9
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_htaccess.erl
@@ -0,0 +1,1150 @@
+%% ``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_htaccess.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+
+-module(mod_htaccess).
+
+-export([do/1, load/2]).
+-export([debug/0]).
+
+-include("httpd.hrl").
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Public methods that interface the eswapi %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+% Public method called by the webbserver to insert the data about
+% Names on accessfiles
+%----------------------------------------------------------------------
+load([$A,$c,$c,$e,$s,$s,$F,$i,$l,$e,$N,$a,$m,$e|FileNames],Context)->
+ CleanFileNames=httpd_conf:clean(FileNames),
+ %%io:format("\n The filenames is:" ++ FileNames ++ "\n"),
+ {ok,[],{access_files,string:tokens(CleanFileNames," ")}}.
+
+
+%----------------------------------------------------------------------
+% Public method that the webbserver calls to control the page
+%----------------------------------------------------------------------
+do(Info)->
+ case httpd_util:key1search(Info#mod.data,status) of
+ {Status_code,PhraseArgs,Reason}->
+ {proceed,Info#mod.data};
+ undefined ->
+ control_path(Info)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The functions that start the control if there is a accessfile %%
+%% and if so controls if the dir is allowed or not %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%Info = record mod as specified in httpd.hrl
+%returns either {proceed,Info#mod.data}
+%{proceed,[{status,403....}|Info#mod.data]}
+%{proceed,[{status,401....}|Info#mod.data]}
+%{proceed,[{status,500....}|Info#mod.data]}
+%----------------------------------------------------------------------
+control_path(Info) ->
+ Path = mod_alias:path(Info#mod.data,
+ Info#mod.config_db,
+ Info#mod.request_uri),
+ case isErlScriptOrNotAccessibleFile(Path,Info) of
+ true->
+ {proceed,Info#mod.data};
+ false->
+ case getHtAccessData(Path,Info)of
+ {ok,public}->
+ %%There was no restrictions on the page continue
+ {proceed,Info#mod.data};
+ {error,Reason} ->
+ %Something got wrong continue or quit??????????????????/
+ {proceed,Info#mod.data};
+ {accessData,AccessData}->
+ controlAllowedMethod(Info,AccessData)
+ end
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% These methods controls that the method the client used in the %%
+%% request is one of the limited %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%Control that if the accessmethod used is in the list of modes to challenge
+%
+%Info is the mod record as specified in httpd.hrl
+%AccessData is an ets table whit the data in the .htaccessfiles
+%----------------------------------------------------------------------
+controlAllowedMethod(Info,AccessData)->
+ case allowedRequestMethod(Info,AccessData) of
+ allow->
+ %%The request didnt use one of the limited methods
+ ets:delete(AccessData),
+ {proceed,Info#mod.data};
+ challenge->
+ authenticateUser(Info,AccessData)
+ end.
+
+%----------------------------------------------------------------------
+%Check the specified access method in the .htaccessfile
+%----------------------------------------------------------------------
+allowedRequestMethod(Info,AccessData)->
+ case ets:lookup(AccessData,limit) of
+ [{limit,all}]->
+ challenge;
+ [{limit,Methods}]->
+ isLimitedRequestMethod(Info,Methods)
+ end.
+
+
+%----------------------------------------------------------------------
+%Check the specified accessmethods in the .htaccesfile against the users
+%accessmethod
+%
+%Info is the record from the do call
+%Methods is a list of the methods specified in the .htaccessfile
+%----------------------------------------------------------------------
+isLimitedRequestMethod(Info,Methods)->
+ case lists:member(Info#mod.method,Methods) of
+ true->
+ challenge;
+ false ->
+ allow
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% These methods controls that the user comes from an allowwed net %%
+%% and if so wheather its a valid user or a challenge shall be %%
+%% generated %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%The first thing to control is that the user is from a network
+%that has access to the page
+%----------------------------------------------------------------------
+authenticateUser(Info,AccessData)->
+ case controlNet(Info,AccessData) of
+ allow->
+ %the network is ok control that it is an allowed user
+ authenticateUser2(Info,AccessData);
+ deny->
+ %The user isnt allowed to access the pages from that network
+ ets:delete(AccessData),
+ {proceed,[{status,{403,Info#mod.request_uri,
+ "Restricted area not allowed from your network"}}|Info#mod.data]}
+ end.
+
+
+%----------------------------------------------------------------------
+%The network the user comes from is allowed to view the resources
+%control whether the user needsto supply a password or not
+%----------------------------------------------------------------------
+authenticateUser2(Info,AccessData)->
+ case ets:lookup(AccessData,require) of
+ [{require,AllowedUsers}]->
+ case ets:lookup(AccessData,auth_name) of
+ [{auth_name,Realm}]->
+ authenticateUser2(Info,AccessData,Realm,AllowedUsers);
+ _NoAuthName->
+ ets:delete(AccessData),
+ {break,[{status,{500,none,
+ ?NICE("mod_htaccess:AuthName directive not specified")}}]}
+ end;
+ [] ->
+ %%No special user is required the network is ok so let
+ %%the user in
+ ets:delete(AccessData),
+ {proceed,Info#mod.data}
+ end.
+
+
+%----------------------------------------------------------------------
+%The user must send a userId and a password to get the resource
+%Control if its already in the http-request
+%if the file with users is bad send an 500 response
+%----------------------------------------------------------------------
+authenticateUser2(Info,AccessData,Realm,AllowedUsers)->
+ case authenticateUser(Info,AccessData,AllowedUsers) of
+ allow ->
+ ets:delete(AccessData),
+ {user,Name,Pwd}=getAuthenticatingDataFromHeader(Info),
+ {proceed, [{remote_user_name,Name}|Info#mod.data]};
+ challenge->
+ ets:delete(AccessData),
+ ReasonPhrase = httpd_util:reason_phrase(401),
+ Message = httpd_util:message(401,none,Info#mod.config_db),
+ {proceed,
+ [{response,
+ {401,
+ ["WWW-Authenticate: Basic realm=\"",Realm,
+ "\"\r\n\r\n","<HTML>\n<HEAD>\n<TITLE>",
+ ReasonPhrase,"</TITLE>\n",
+ "</HEAD>\n<BODY>\n<H1>",ReasonPhrase,
+ "</H1>\n",Message,"\n</BODY>\n</HTML>\n"]}}|
+ Info#mod.data]};
+ deny->
+ ets:delete(AccessData),
+ {break,[{status,{500,none,
+ ?NICE("mod_htaccess:Bad path to user or group file")}}]}
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Methods that validate the netwqork the user comes from %%
+%% according to the allowed networks %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%---------------------------------------------------------------------
+%Controls the users networkaddress agains the specifed networks to
+%allow or deny
+%
+%returns either allow or deny
+%----------------------------------------------------------------------
+controlNet(Info,AccessData)->
+ UserNetwork=getUserNetworkAddress(Info),
+ case getAllowDenyOrder(AccessData) of
+ {_deny,[],_allow,[]}->
+ allow;
+ {deny,[],allow,AllowedNetworks}->
+ controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny);
+ {allow,AllowedNetworks,deny,[]}->
+ controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny);
+
+ {deny,DeniedNetworks,allow,[]}->
+ controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny);
+ {allow,[],deny,DeniedNetworks}->
+ controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny);
+
+ {deny,DeniedNetworks,allow,AllowedNetworks}->
+ controlDenyAllow(DeniedNetworks,AllowedNetworks,UserNetwork);
+ {allow,AllowedNetworks,deny,DeniedNetworks}->
+ controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork)
+ end.
+
+
+%----------------------------------------------------------------------
+%Returns the users IP-Number
+%----------------------------------------------------------------------
+getUserNetworkAddress(Info)->
+ {_Socket,Address}=(Info#mod.init_data)#init_data.peername,
+ Address.
+
+
+%----------------------------------------------------------------------
+%Control the users Ip-number against the ip-numbers in the .htaccessfile
+%----------------------------------------------------------------------
+controlIfAllowed(AllowedNetworks,UserNetwork,IfAllowed,IfDenied)->
+ case AllowedNetworks of
+ [{allow,all}]->
+ IfAllowed;
+ [{deny,all}]->
+ IfDenied;
+ [{deny,Networks}]->
+ memberNetwork(Networks,UserNetwork,IfDenied,IfAllowed);
+ [{allow,Networks}]->
+ memberNetwork(Networks,UserNetwork,IfAllowed,IfDenied);
+ _Error->
+ IfDenied
+ end.
+
+
+%---------------------------------------------------------------------%
+%The Denycontrol isn't neccessary to preform since the allow control %
+%override the deny control %
+%---------------------------------------------------------------------%
+controlDenyAllow(DeniedNetworks,AllowedNetworks,UserNetwork)->
+ case AllowedNetworks of
+ [{allow,all}]->
+ allow;
+ [{allow,Networks}]->
+ case memberNetwork(Networks,UserNetwork) of
+ true->
+ allow;
+ false->
+ deny
+ end
+ end.
+
+
+%----------------------------------------------------------------------%
+%Control that the user is in the allowed list if so control that the %
+%network is in the denied list
+%----------------------------------------------------------------------%
+controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork)->
+ case controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny) of
+ allow->
+ controlIfAllowed(DeniedNetworks,UserNetwork,deny,allow);
+ deny ->
+ deny
+ end.
+
+%----------------------------------------------------------------------
+%Controls if the users Ipnumber is in the list of either denied or
+%allowed networks
+%----------------------------------------------------------------------
+memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)->
+ case memberNetwork(Networks,UserNetwork) of
+ true->
+ IfTrue;
+ false->
+ IfFalse
+ end.
+
+
+%----------------------------------------------------------------------
+%regexp match the users ip-address against the networks in the list of
+%ipadresses or subnet addresses.
+memberNetwork(Networks,UserNetwork)->
+ case lists:filter(fun(Net)->
+ case regexp:match(UserNetwork,
+ formatRegexp(Net)) of
+ {match,1,_}->
+ true;
+ _NotSubNet ->
+ false
+ end
+ end,Networks) of
+ []->
+ false;
+ MemberNetWork ->
+ true
+ end.
+
+
+%----------------------------------------------------------------------
+%Creates a regexp from an ip-number i.e "127.0.0-> "^127[.]0[.]0.*"
+%"127.0.0.-> "^127[.]0[.]0[.].*"
+%----------------------------------------------------------------------
+formatRegexp(Net)->
+ [SubNet1|SubNets]=string:tokens(Net,"."),
+ NetRegexp=lists:foldl(fun(SubNet,Newnet)->
+ Newnet ++ "[.]" ++SubNet
+ end,"^"++SubNet1,SubNets),
+ case string:len(Net)-string:rchr(Net,$.) of
+ 0->
+ NetRegexp++"[.].*";
+ _->
+ NetRegexp++".*"
+ end.
+
+
+%----------------------------------------------------------------------
+%If the user has specified if the allow or deny check shall be preformed
+%first get that order if no order is specified take
+%allow - deny since its harder that deny - allow
+%----------------------------------------------------------------------
+getAllowDenyOrder(AccessData)->
+ case ets:lookup(AccessData,order) of
+ [{order,{deny,allow}}]->
+ {deny,ets:lookup(AccessData,deny),
+ allow,ets:lookup(AccessData,allow)};
+ _DefaultOrder->
+ {allow,ets:lookup(AccessData,allow),
+ deny,ets:lookup(AccessData,deny)}
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The methods that validates the user %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+%Control if there is anyu autheticating data in threquest header
+%if so it controls it against the users in the list Allowed Users
+%----------------------------------------------------------------------
+authenticateUser(Info,AccessData,AllowedUsers)->
+ case getAuthenticatingDataFromHeader(Info) of
+ {user,User,PassWord}->
+ authenticateUser(Info,AccessData,AllowedUsers,
+ {user,User,PassWord});
+ {error,nouser}->
+ challenge;
+ {error,BadData}->
+ challenge
+ end.
+
+
+%----------------------------------------------------------------------
+%Returns the Autheticating data in the http-request
+%----------------------------------------------------------------------
+getAuthenticatingDataFromHeader(Info)->
+ PrsedHeader=Info#mod.parsed_header,
+ case httpd_util:key1search(PrsedHeader,"authorization" ) of
+ undefined->
+ {error,nouser};
+ [$B,$a,$s,$i,$c,$\ |EncodedString]->
+ UnCodedString=httpd_util:decode_base64(EncodedString),
+ case httpd_util:split(UnCodedString,":",2) of
+ {ok,[User,PassWord]}->
+ {user,User,PassWord};
+ {error,Error}->
+ {error,Error}
+ end;
+ BadCredentials ->
+ {error,BadCredentials}
+ end.
+
+
+%----------------------------------------------------------------------
+%Returns a list of all members of the allowed groups
+%----------------------------------------------------------------------
+getGroupMembers(Groups,AllowedGroups)->
+ Allowed=lists:foldl(fun({group,Name,Members},AllowedMembers)->
+ case lists:member(Name,AllowedGroups) of
+ true->
+ AllowedMembers++Members;
+ false ->
+ AllowedMembers
+ end
+ end,[],Groups),
+ {ok,Allowed}.
+
+authenticateUser(Info,AccessData,{{users,[]},{groups,Groups}},User)->
+ authenticateUser(Info,AccessData,{groups,Groups},User);
+authenticateUser(Info,AccessData,{{users,Users},{groups,[]}},User)->
+ authenticateUser(Info,AccessData,{users,Users},User);
+
+authenticateUser(Info,AccessData,{{users,Users},{groups,Groups}},User)->
+ AllowUser=authenticateUser(Info,AccessData,{users,Users},User),
+ AllowGroup=authenticateUser(Info,AccessData,{groups,Groups},User),
+ case {AllowGroup,AllowUser} of
+ {_,allow}->
+ allow;
+ {allow,_}->
+ allow;
+ {challenge,_}->
+ challenge;
+ {_,challenge}->
+ challenge;
+ {_deny,_deny}->
+ deny
+ end;
+
+
+%----------------------------------------------------------------------
+%Controls that the user is a member in one of the allowed group
+%----------------------------------------------------------------------
+authenticateUser(Info,AccessData,{groups,AllowedGroups},{user,User,PassWord})->
+ case getUsers(AccessData,group_file) of
+ {group_data,Groups}->
+ case getGroupMembers(Groups,AllowedGroups) of
+ {ok,Members}->
+ authenticateUser(Info,AccessData,{users,Members},
+ {user,User,PassWord});
+ {error,BadData}->
+ deny
+ end;
+ {error,BadData}->
+ deny
+ end;
+
+
+%----------------------------------------------------------------------
+%Control that the user is one of the allowed users and that the passwd is ok
+%----------------------------------------------------------------------
+authenticateUser(Info,AccessData,{users,AllowedUsers},{user,User,PassWord})->
+ case lists:member(User,AllowedUsers) of
+ true->
+ %Get the usernames and passwords from the file
+ case getUsers(AccessData,user_file) of
+ {error,BadData}->
+ deny;
+ {user_data,Users}->
+ %Users is a list of the users in
+ %the userfile [{user,User,Passwd}]
+ checkPassWord(Users,{user,User,PassWord})
+ end;
+ false ->
+ challenge
+ end.
+
+
+%----------------------------------------------------------------------
+%Control that the user User={user,"UserName","PassWd"} is
+%member of the list of Users
+%----------------------------------------------------------------------
+checkPassWord(Users,User)->
+ case lists:member(User,Users) of
+ true->
+ allow;
+ false->
+ challenge
+ end.
+
+
+%----------------------------------------------------------------------
+%Get the users in the specified file
+%UserOrGroup is an atom that specify if its a group file or a user file
+%i.e. group_file or user_file
+%----------------------------------------------------------------------
+getUsers({file,FileName},UserOrGroup)->
+ case file:open(FileName,[read]) of
+ {ok,AccessFileHandle} ->
+ getUsers({stream,AccessFileHandle},[],UserOrGroup);
+ {error,Reason} ->
+ {error,{Reason,FileName}}
+ end;
+
+
+%----------------------------------------------------------------------
+%The method that starts the lokkong for user files
+%----------------------------------------------------------------------
+
+getUsers(AccessData,UserOrGroup)->
+ case ets:lookup(AccessData,UserOrGroup) of
+ [{UserOrGroup,File}]->
+ getUsers({file,File},UserOrGroup);
+ _ ->
+ {error,noUsers}
+ end.
+
+
+%----------------------------------------------------------------------
+%Reads data from the filehandle File to the list FileData and when its
+%reach the end it returns the list in a tuple {user_file|group_file,FileData}
+%----------------------------------------------------------------------
+getUsers({stream,File},FileData,UserOrGroup)->
+ case io:get_line(File,[]) of
+ eof when UserOrGroup==user_file->
+ {user_data,FileData};
+ eof when UserOrGroup ==group_file->
+ {group_data,FileData};
+ Line ->
+ getUsers({stream,File},
+ formatUser(Line,FileData,UserOrGroup),UserOrGroup)
+ end.
+
+
+%----------------------------------------------------------------------
+%If the line is a comment remove it
+%----------------------------------------------------------------------
+formatUser([$#|UserDataComment],FileData,_UserOrgroup)->
+ FileData;
+
+
+%----------------------------------------------------------------------
+%The user name in the file is Username:Passwd\n
+%Remove the newline sign and split the user name in
+%UserName and Password
+%----------------------------------------------------------------------
+formatUser(UserData,FileData,UserOrGroup)->
+ case string:tokens(UserData," \r\n")of
+ [User|Whitespace] when UserOrGroup==user_file->
+ case string:tokens(User,":") of
+ [Name,PassWord]->
+ [{user,Name,PassWord}|FileData];
+ _Error->
+ FileData
+ end;
+ GroupData when UserOrGroup==group_file ->
+ parseGroupData(GroupData,FileData);
+ _Error ->
+ FileData
+ end.
+
+
+%----------------------------------------------------------------------
+%if everything is right GroupData is on the form
+% ["groupName:", "Member1", "Member2", "Member2"
+%----------------------------------------------------------------------
+parseGroupData([GroupName|GroupData],FileData)->
+ [{group,formatGroupName(GroupName),GroupData}|FileData].
+
+
+%----------------------------------------------------------------------
+%the line in the file is GroupName: Member1 Member2 .....MemberN
+%Remove the : from the group name
+%----------------------------------------------------------------------
+formatGroupName(GroupName)->
+ string:strip(GroupName,right,$:).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Functions that parses the accessfiles %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%Control that the asset is a real file and not a request for an virtual
+%asset
+%----------------------------------------------------------------------
+isErlScriptOrNotAccessibleFile(Path,Info)->
+ case file:read_file_info(Path) of
+ {ok,_fileInfo}->
+ false;
+ {error,_Reason} ->
+ true
+ end.
+
+
+%----------------------------------------------------------------------
+%Path=PathToTheRequestedFile=String
+%Innfo=record#mod
+%----------------------------------------------------------------------
+getHtAccessData(Path,Info)->
+ HtAccessFileNames=getHtAccessFileNames(Info),
+ case getData(Path,Info,HtAccessFileNames) of
+ {ok,public}->
+ {ok,public};
+ {accessData,AccessData}->
+ {accessData,AccessData};
+ {error,Reason} ->
+ {error,Reason}
+ end.
+
+
+%----------------------------------------------------------------------
+%returns the names of the accessfiles
+%----------------------------------------------------------------------
+getHtAccessFileNames(Info)->
+ case httpd_util:lookup(Info#mod.config_db,access_files) of
+ undefined->
+ [".htaccess"];
+ Files->
+ Files
+ end.
+%----------------------------------------------------------------------
+%HtAccessFileNames=["accessfileName1",..."AccessFileName2"]
+%----------------------------------------------------------------------
+getData(Path,Info,HtAccessFileNames)->
+ case regexp:split(Path,"/") of
+ {error,Error}->
+ {error,Error};
+ {ok,SplittedPath}->
+ getData2(HtAccessFileNames,SplittedPath,Info)
+ end.
+
+
+%----------------------------------------------------------------------
+%Add to together the data in the Splittedpath up to the path
+%that is the alias or the document root
+%Since we do not need to control after any accessfiles before here
+%----------------------------------------------------------------------
+getData2(HtAccessFileNames,SplittedPath,Info)->
+ case getRootPath(SplittedPath,Info) of
+ {error,Path}->
+ {error,Path};
+ {ok,StartPath,RestOfSplittedPath} ->
+ getData2(HtAccessFileNames,StartPath,RestOfSplittedPath,Info)
+ end.
+
+
+%----------------------------------------------------------------------
+%HtAccessFilenames is a list the names the accesssfiles can have
+%Path is the shortest match agains all alias and documentroot
+%rest of splitted path is a list of the parts of the path
+%Info is the mod recod from the server
+%----------------------------------------------------------------------
+getData2(HtAccessFileNames,StartPath,RestOfSplittedPath,Info)->
+ case getHtAccessFiles(HtAccessFileNames,StartPath,RestOfSplittedPath) of
+ []->
+ %No accessfile qiut its a public directory
+ {ok,public};
+ Files ->
+ loadAccessFilesData(Files)
+ end.
+
+
+%----------------------------------------------------------------------
+%Loads the data in the accessFiles specifiied by
+% AccessFiles=["/hoem/public/html/accefile",
+% "/home/public/html/priv/accessfile"]
+%----------------------------------------------------------------------
+loadAccessFilesData(AccessFiles)->
+ loadAccessFilesData(AccessFiles,ets:new(accessData,[])).
+
+
+%----------------------------------------------------------------------
+%Returns the found data
+%----------------------------------------------------------------------
+contextToValues(AccessData)->
+ case ets:lookup(AccessData,context) of
+ [{context,Values}]->
+ ets:delete(AccessData,context),
+ insertContext(AccessData,Values),
+ {accessData,AccessData};
+ _Error->
+ {error,errorInAccessFile}
+ end.
+
+
+insertContext(AccessData,[])->
+ ok;
+
+insertContext(AccessData,[{allow,From}|Values])->
+ insertDenyAllowContext(AccessData,{allow,From}),
+ insertContext(AccessData,Values);
+
+insertContext(AccessData,[{deny,From}|Values])->
+ insertDenyAllowContext(AccessData,{deny,From}),
+ insertContext(AccessData,Values);
+
+insertContext(AccessData,[{require,{GrpOrUsr,Members}}|Values])->
+ case ets:lookup(AccessData,require) of
+ []when GrpOrUsr==users->
+ ets:insert(AccessData,{require,{{users,Members},{groups,[]}}});
+
+ [{require,{{users,Users},{groups,Groups}}}]when GrpOrUsr==users ->
+ ets:insert(AccessData,{require,{{users,Users++Members},
+ {groups,Groups}}});
+ []when GrpOrUsr==groups->
+ ets:insert(AccessData,{require,{{users,[]},{groups,Members}}});
+
+ [{require,{{users,Users},{groups,Groups}}}]when GrpOrUsr==groups ->
+ ets:insert(AccessData,{require,{{users,Users},
+ {groups,Groups++Members}}})
+ end,
+ insertContext(AccessData,Values);
+
+
+
+%%limit and order directive need no transforming they areis just to insert
+insertContext(AccessData,[Elem|Values])->
+ ets:insert(AccessData,Elem),
+ insertContext(AccessData,Values).
+
+
+insertDenyAllowContext(AccessData,{AllowDeny,From})->
+ case From of
+ all->
+ ets:insert(AccessData,{AllowDeny,all});
+ AllowedSubnets->
+ case ets:lookup(AccessData,AllowDeny) of
+ []->
+ ets:insert(AccessData,{AllowDeny,From});
+ [{AllowDeny,all}]->
+ ok;
+ [{AllowDeny,Networks}]->
+ ets:insert(AccessData,{allow,Networks++From})
+ end
+ end.
+
+loadAccessFilesData([],AccessData)->
+ %preform context to limits
+ contextToValues(AccessData),
+ {accessData,AccessData};
+
+%----------------------------------------------------------------------
+%Takes each file in the list and load the data to the ets table
+%AccessData
+%----------------------------------------------------------------------
+loadAccessFilesData([FileName|FileNames],AccessData)->
+ case loadAccessFileData({file,FileName},AccessData) of
+ overRide->
+ loadAccessFilesData(FileNames,AccessData);
+ noOverRide ->
+ {accessData,AccessData};
+ error->
+ ets:delete(AccessData),
+ {error,errorInAccessFile}
+ end.
+
+%----------------------------------------------------------------------
+%opens the filehandle to the specified file
+%----------------------------------------------------------------------
+loadAccessFileData({file,FileName},AccessData)->
+ case file:open(FileName,[read]) of
+ {ok,AccessFileHandle}->
+ loadAccessFileData({stream,AccessFileHandle},AccessData,[]);
+ {error,Reason} ->
+ overRide
+ end.
+
+%----------------------------------------------------------------------
+%%look att each line in the file and add them to the database
+%%When end of file is reached control i overrride is allowed
+%% if so return
+%----------------------------------------------------------------------
+loadAccessFileData({stream,File},AccessData,FileData)->
+ case io:get_line(File,[]) of
+ eof->
+ insertData(AccessData,FileData),
+ case ets:match_object(AccessData,{'_',error}) of
+ []->
+ %Case we got no error control that we can override a
+ %at least some of the values
+ case ets:match_object(AccessData,
+ {allow_over_ride,none}) of
+ []->
+ overRide;
+ _NoOverride->
+ noOverRide
+ end;
+ Errors->
+ error
+ end;
+ Line ->
+ loadAccessFileData({stream,File},AccessData,
+ insertLine(string:strip(Line,left),FileData))
+ end.
+
+%----------------------------------------------------------------------
+%AccessData is a ets table where the previous found data is inserted
+%FileData is a list of the directives in the last parsed file
+%before insertion a control is done that the directive is allowed to
+%override
+%----------------------------------------------------------------------
+insertData(AccessData,{{context,Values},FileData})->
+ insertData(AccessData,[{context,Values}|FileData]);
+
+insertData(AccessData,FileData)->
+ case ets:lookup(AccessData,allow_over_ride) of
+ [{allow_over_ride,all}]->
+ lists:foreach(fun(Elem)->
+ ets:insert(AccessData,Elem)
+ end,FileData);
+ []->
+ lists:foreach(fun(Elem)->
+ ets:insert(AccessData,Elem)
+ end,FileData);
+ [{allow_over_ride,Directives}]when list(Directives)->
+ lists:foreach(fun({Key,Value})->
+ case lists:member(Key,Directives) of
+ true->
+ ok;
+ false ->
+ ets:insert(AccessData,{Key,Value})
+ end
+ end,FileData);
+ [{allow_over_ride,_}]->
+ %Will never appear if the user
+ %aint doing very strang econfig files
+ ok
+ end.
+%----------------------------------------------------------------------
+%Take a line in the accessfile and transform it into a tuple that
+%later can be inserted in to the ets:table
+%----------------------------------------------------------------------
+%%%Here is the alternatives that resides inside the limit context
+
+insertLine([$o,$r,$d,$e,$r|Order],{{context,Values},FileData})->
+ {{context,[{order,getOrder(Order)}|Values]},FileData};
+%%Let the user place a tab in the beginning
+insertLine([$\t,$o,$r,$d,$e,$r|Order],{{context,Values},FileData})->
+ {{context,[{order,getOrder(Order)}|Values]},FileData};
+
+insertLine([$a,$l,$l,$o,$w|Allow],{{context,Values},FileData})->
+ {{context,[{allow,getAllowDenyData(Allow)}|Values]},FileData};
+insertLine([$\t,$a,$l,$l,$o,$w|Allow],{{context,Values},FileData})->
+ {{context,[{allow,getAllowDenyData(Allow)}|Values]},FileData};
+
+insertLine([$d,$e,$n,$y|Deny],{{context,Values},FileData})->
+ {{context,[{deny,getAllowDenyData(Deny)}|Values]},FileData};
+insertLine([$\t,$d,$e,$n,$y|Deny],{{context,Values},FileData})->
+ {{context,[{deny,getAllowDenyData(Deny)}|Values]},FileData};
+
+
+insertLine([$r,$e,$q,$u,$i,$r,$e|Require],{{context,Values},FileData})->
+ {{context,[{require,getRequireData(Require)}|Values]},FileData};
+insertLine([$\t,$r,$e,$q,$u,$i,$r,$e|Require],{{context,Values},FileData})->
+ {{context,[{require,getRequireData(Require)}|Values]},FileData};
+
+
+insertLine([$<,$/,$L,$i,$m,$i,$t|EndLimit],{Context,FileData})->
+ [Context|FileData];
+
+insertLine([$<,$L,$i,$m,$i,$t|Limit],FileData)->
+ {{context,[{limit,getLimits(Limit)}]}, FileData};
+
+
+
+insertLine([$A,$u,$t,$h,$U,$s,$e,$r,$F,$i,$l,$e,$\ |AuthUserFile],FileData)->
+ [{user_file,string:strip(AuthUserFile,right,$\n)}|FileData];
+
+insertLine([$A,$u,$t,$h,$G,$r,$o,$u,$p,$F,$i,$l,$e,$\ |AuthGroupFile],
+ FileData)->
+ [{group_file,string:strip(AuthGroupFile,right,$\n)}|FileData];
+
+insertLine([$A,$l,$l,$o,$w,$O,$v,$e,$r,$R,$i,$d,$e|AllowOverRide],FileData)->
+ [{allow_over_ride,getAllowOverRideData(AllowOverRide)}
+ |FileData];
+
+insertLine([$A,$u,$t,$h,$N,$a,$m,$e,$\ |AuthName],FileData)->
+ [{auth_name,string:strip(AuthName,right,$\n)}|FileData];
+
+insertLine([$A,$u,$t,$h,$T,$y,$p,$e|AuthType],FileData)->
+ [{auth_type,getAuthorizationType(AuthType)}|FileData];
+
+insertLine(_BadDirectiveOrComment,FileData)->
+ FileData.
+
+%----------------------------------------------------------------------
+%transform the Data specified about override to a form that is ieasier
+%handled later
+%Override data="all"|"md5"|"Directive1 .... DirectioveN"
+%----------------------------------------------------------------------
+
+getAllowOverRideData(OverRideData)->
+ case string:tokens(OverRideData," \r\n") of
+ [[$a,$l,$l]|_]->
+ all;
+ [[$n,$o,$n,$e]|_]->
+ none;
+ Directives ->
+ getOverRideDirectives(Directives)
+ end.
+
+getOverRideDirectives(Directives)->
+ lists:map(fun(Directive)->
+ transformDirective(Directive)
+ end,Directives).
+transformDirective([$A,$u,$t,$h,$U,$s,$e,$r,$F,$i,$l,$e|_])->
+ user_file;
+transformDirective([$A,$u,$t,$h,$G,$r,$o,$u,$p,$F,$i,$l,$e|_]) ->
+ group_file;
+transformDirective([$A,$u,$t,$h,$N,$a,$m,$e|_])->
+ auth_name;
+transformDirective([$A,$u,$t,$h,$T,$y,$p,$e|_])->
+ auth_type;
+transformDirective(_UnAllowedOverRideDirective) ->
+ unallowed.
+%----------------------------------------------------------------------
+%Replace the string that specify which method to use for authentication
+%and replace it with the atom for easier mathing
+%----------------------------------------------------------------------
+getAuthorizationType(AuthType)->
+ [Arg|Crap]=string:tokens(AuthType,"\n\r\ "),
+ case Arg of
+ [$B,$a,$s,$i,$c]->
+ basic;
+ [$M,$D,$5] ->
+ md5;
+ _What ->
+ error
+ end.
+%----------------------------------------------------------------------
+%Returns a list of the specified methods to limit or the atom all
+%----------------------------------------------------------------------
+getLimits(Limits)->
+ case regexp:split(Limits,">")of
+ {ok,[_NoEndOnLimit]}->
+ error;
+ {ok,[Methods|Crap]}->
+ case regexp:split(Methods," ")of
+ {ok,[]}->
+ all;
+ {ok,SplittedMethods}->
+ SplittedMethods;
+ {error,Error}->
+ error
+ end;
+ {error,_Error}->
+ error
+ end.
+
+
+%----------------------------------------------------------------------
+% Transform the order to prefrom deny allow control to a tuple of atoms
+%----------------------------------------------------------------------
+getOrder(Order)->
+ [First|Rest]=lists:map(fun(Part)->
+ list_to_atom(Part)
+ end,string:tokens(Order," \n\r")),
+ case First of
+ deny->
+ {deny,allow};
+ allow->
+ {allow,deny};
+ _Error->
+ error
+ end.
+
+%----------------------------------------------------------------------
+% The string AllowDeny is "from all" or "from Subnet1 Subnet2...SubnetN"
+%----------------------------------------------------------------------
+getAllowDenyData(AllowDeny)->
+ case string:tokens(AllowDeny," \n\r") of
+ [_From|AllowDenyData] when length(AllowDenyData)>=1->
+ case lists:nth(1,AllowDenyData) of
+ [$a,$l,$l]->
+ all;
+ Hosts->
+ AllowDenyData
+ end;
+ Error->
+ errror
+ end.
+%----------------------------------------------------------------------
+% Fix the string that describes who is allowed to se the page
+%----------------------------------------------------------------------
+getRequireData(Require)->
+ [UserOrGroup|UserData]=string:tokens(Require," \n\r"),
+ case UserOrGroup of
+ [$u,$s,$e,$r]->
+ {users,UserData};
+ [$g,$r,$o,$u,$p] ->
+ {groups,UserData};
+ _Whatever ->
+ error
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Methods that collects the searchways to the accessfiles %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+% Get the whole path to the different accessfiles
+%----------------------------------------------------------------------
+getHtAccessFiles(HtAccessFileNames,Path,RestOfSplittedPath)->
+ getHtAccessFiles(HtAccessFileNames,Path,RestOfSplittedPath,[]).
+
+getHtAccessFiles(HtAccessFileNames,Path,[[]],HtAccessFiles)->
+ HtAccessFiles ++ accessFilesOfPath(HtAccessFileNames,Path++"/");
+
+getHtAccessFiles(HtAccessFileNames,Path,[],HtAccessFiles)->
+ HtAccessFiles;
+getHtAccessFiles(HtAccessFileNames,Path,[NextDir|RestOfSplittedPath],
+ AccessFiles)->
+ getHtAccessFiles(HtAccessFileNames,Path++"/"++NextDir,RestOfSplittedPath,
+ AccessFiles ++
+ accessFilesOfPath(HtAccessFileNames,Path++"/")).
+
+
+%----------------------------------------------------------------------
+%Control if therer are any accessfies in the path
+%----------------------------------------------------------------------
+accessFilesOfPath(HtAccessFileNames,Path)->
+ lists:foldl(fun(HtAccessFileName,Files)->
+ case file:read_file_info(Path++HtAccessFileName) of
+ {ok,FileInfo}->
+ [Path++HtAccessFileName|Files];
+ {error,_Error} ->
+ Files
+ end
+ end,[],HtAccessFileNames).
+
+
+%----------------------------------------------------------------------
+%Sake the splitted path and joins it up to the documentroot or the alias
+%that match first
+%----------------------------------------------------------------------
+
+getRootPath(SplittedPath,Info)->
+ DocRoot=httpd_util:lookup(Info#mod.config_db,document_root,"/"),
+ PresumtiveRootPath=
+ [DocRoot|lists:map(fun({Alias,RealPath})->
+ RealPath
+ end,
+ httpd_util:multi_lookup(Info#mod.config_db,alias))],
+ getRootPath(PresumtiveRootPath,SplittedPath,Info).
+
+
+getRootPath(PresumtiveRootPath,[[],Splittedpath],Info)->
+ getRootPath(PresumtiveRootPath,["/",Splittedpath],Info);
+
+
+getRootPath(PresumtiveRootPath,[Part,NextPart|SplittedPath],Info)->
+ case lists:member(Part,PresumtiveRootPath)of
+ true->
+ {ok,Part,[NextPart|SplittedPath]};
+ false ->
+ getRootPath(PresumtiveRootPath,
+ [Part++"/"++NextPart|SplittedPath],Info)
+ end;
+
+getRootPath(PresumtiveRootPath,[Part],Info)->
+ case lists:member(Part,PresumtiveRootPath)of
+ true->
+ {ok,Part,[]};
+ false ->
+ {error,Part}
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%Debug methods %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+% Simulate the webserver by calling do/1 with apropiate parameters
+%----------------------------------------------------------------------
+debug()->
+ Conf=getConfigData(),
+ Uri=getUri(),
+ {_Proceed,Data}=getDataFromAlias(Conf,Uri),
+ Init_data=#init_data{peername={socket,"127.0.0.1"}},
+ ParsedHeader=headerparts(),
+ do(#mod{init_data=Init_data,
+ data=Data,
+ config_db=Conf,
+ request_uri=Uri,
+ parsed_header=ParsedHeader,
+ method="GET"}).
+
+%----------------------------------------------------------------------
+%Add authenticate data to the fake http-request header
+%----------------------------------------------------------------------
+headerparts()->
+ [{"authorization","Basic " ++ httpd_util:encode_base64("lotta:potta")}].
+
+getDataFromAlias(Conf,Uri)->
+ mod_alias:do(#mod{config_db=Conf,request_uri=Uri}).
+
+getUri()->
+ "/appmon/test/test.html".
+
+getConfigData()->
+ Tab=ets:new(test_inets,[bag,public]),
+ ets:insert(Tab,{server_name,"localhost"}),
+ ets:insert(Tab,{bind_addresss,{127,0,0,1}}),
+ ets:insert(Tab,{erl_script_alias,{"/webcover/erl",["webcover"]}}),
+ ets:insert(Tab,{erl_script_alias,{"/erl",["webappmon"]}}),
+ ets:insert(Tab,{com_type,ip_comm}),
+ ets:insert(Tab,{modules,[mod_alias,mod_auth,mod_header]}),
+ ets:insert(Tab,{default_type,"text/plain"}),
+ ets:insert(Tab,{server_root,
+ "/home/gandalf/marting/exjobb/webtool-1.0/priv/root"}),
+ ets:insert(Tab,{port,8888}),
+ ets:insert(Tab,{document_root,
+ "/home/gandalf/marting/exjobb/webtool-1.0/priv/root"}),
+ ets:insert(Tab,
+ {alias,
+ {"/appmon"
+ ,"/home/gandalf/marting/exjobb/webappmon-1.0/priv"}}),
+ ets:insert(Tab,{alias,
+ {"/webcover"
+ ,"/home/gandalf/marting/exjobb/webcover-1.0/priv"}}),
+ ets:insert(Tab,{access_file,[".htaccess","kalle","pelle"]}),
+ Tab.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_include.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_include.erl
new file mode 100644
index 0000000000..c93e0a4f59
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_include.erl
@@ -0,0 +1,726 @@
+%% ``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_include.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_include).
+-export([do/1,parse/2,config/6,include/6,echo/6,fsize/6,flastmod/6,exec/6]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"INCLUDE").
+-include("httpd_verbosity.hrl").
+
+%% do
+
+do(Info) ->
+ ?vtrace("do",[]),
+ case Info#mod.method of
+ "GET" ->
+ 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 ->
+ case httpd_util:key1search(Info#mod.data, response) of
+ %% No response has been generated!
+ undefined ->
+ do_include(Info);
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end;
+ %% Not a GET method!
+ _ ->
+ {proceed,Info#mod.data}
+ end.
+
+do_include(Info) ->
+ ?vtrace("do_include -> entry with"
+ "~n URI: ~p",[Info#mod.request_uri]),
+ Path = mod_alias:path(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri),
+ Suffix = httpd_util:suffix(Path),
+ case httpd_util:lookup_mime_default(Info#mod.config_db,Suffix) of
+ "text/x-server-parsed-html" ->
+ HeaderStart =
+ httpd_util:header(200, "text/html", Info#mod.connection),
+ ?vtrace("do_include -> send ~p", [Path]),
+ case send_in(Info,Path,HeaderStart,file:read_file_info(Path)) of
+ {ok, ErrorLog, Size} ->
+ ?vtrace("do_include -> sent ~w bytes", [Size]),
+ {proceed,[{response,{already_sent,200,Size}},
+ {mime_type,"text/html"}|
+ lists:append(ErrorLog,Info#mod.data)]};
+ {error, Reason} ->
+ ?vlog("send in failed:"
+ "~n Reason: ~p"
+ "~n Path: ~p"
+ "~n Info: ~p",
+ [Reason,Info,Path]),
+ {proceed,
+ [{status,send_error(Reason,Info,Path)}|Info#mod.data]}
+ end;
+ _ -> %% Unknown mime type, ignore
+ {proceed,Info#mod.data}
+ end.
+
+
+%%
+%% config directive
+%%
+
+config(Info, Context, ErrorLog, TagList, ValueList, R) ->
+ case verify_tags("config",[errmsg,timefmt,sizefmt],
+ TagList,ValueList) of
+ ok ->
+ {ok,update_context(TagList,ValueList,Context),ErrorLog,"",R};
+ {error,Reason} ->
+ {ok,Context,[{internal_info,Reason}|ErrorLog],
+ httpd_util:key1search(Context,errmsg,""),R}
+ end.
+
+update_context([],[],Context) ->
+ Context;
+update_context([Tag|R1],[Value|R2],Context) ->
+ update_context(R1,R2,[{Tag,Value}|Context]).
+
+verify_tags(Command,ValidTags,TagList,ValueList) when length(TagList)==length(ValueList) ->
+ verify_tags(Command,ValidTags,TagList);
+verify_tags(Command,ValidTags,TagList,ValueList) ->
+ {error,?NICE(Command++" directive has spurious tags")}.
+
+verify_tags(Command, ValidTags, []) ->
+ ok;
+verify_tags(Command, ValidTags, [Tag|Rest]) ->
+ case lists:member(Tag, ValidTags) of
+ true ->
+ verify_tags(Command, ValidTags, Rest);
+ false ->
+ {error,?NICE(Command++" directive has a spurious tag ("++
+ atom_to_list(Tag)++")")}
+ end.
+
+%%
+%% include directive
+%%
+
+include(Info,Context,ErrorLog,[virtual],[VirtualPath],R) ->
+ Aliases = httpd_util:multi_lookup(Info#mod.config_db,alias),
+ {_, Path, _AfterPath} =
+ mod_alias:real_name(Info#mod.config_db, VirtualPath, Aliases),
+ include(Info,Context,ErrorLog,R,Path);
+include(Info, Context, ErrorLog, [file], [FileName], R) ->
+ Path = file(Info#mod.config_db, Info#mod.request_uri, FileName),
+ include(Info, Context, ErrorLog, R, Path);
+include(Info, Context, ErrorLog, TagList, ValueList, R) ->
+ {ok, Context,
+ [{internal_info,?NICE("include directive has a spurious tag")}|
+ ErrorLog], httpd_util:key1search(Context, errmsg, ""), R}.
+
+include(Info, Context, ErrorLog, R, Path) ->
+ ?DEBUG("include -> read file: ~p",[Path]),
+ case file:read_file(Path) of
+ {ok, Body} ->
+ ?DEBUG("include -> size(Body): ~p",[size(Body)]),
+ {ok, NewContext, NewErrorLog, Result} =
+ parse(Info, binary_to_list(Body), Context, ErrorLog, []),
+ {ok, Context, NewErrorLog, Result, R};
+ {error, Reason} ->
+ {ok, Context,
+ [{internal_info, ?NICE("Can't open "++Path)}|ErrorLog],
+ httpd_util:key1search(Context, errmsg, ""), R}
+ end.
+
+file(ConfigDB, RequestURI, FileName) ->
+ Aliases = httpd_util:multi_lookup(ConfigDB, alias),
+ {_, Path, _AfterPath}
+ = mod_alias:real_name(ConfigDB, RequestURI, Aliases),
+ Pwd = filename:dirname(Path),
+ filename:join(Pwd, FileName).
+
+%%
+%% echo directive
+%%
+
+echo(Info,Context,ErrorLog,[var],["DOCUMENT_NAME"],R) ->
+ {ok,Context,ErrorLog,document_name(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri),R};
+echo(Info,Context,ErrorLog,[var],["DOCUMENT_URI"],R) ->
+ {ok,Context,ErrorLog,document_uri(Info#mod.config_db,
+ Info#mod.request_uri),R};
+echo(Info,Context,ErrorLog,[var],["QUERY_STRING_UNESCAPED"],R) ->
+ {ok,Context,ErrorLog,query_string_unescaped(Info#mod.request_uri),R};
+echo(Info,Context,ErrorLog,[var],["DATE_LOCAL"],R) ->
+ {ok,Context,ErrorLog,date_local(),R};
+echo(Info,Context,ErrorLog,[var],["DATE_GMT"],R) ->
+ {ok,Context,ErrorLog,date_gmt(),R};
+echo(Info,Context,ErrorLog,[var],["LAST_MODIFIED"],R) ->
+ {ok,Context,ErrorLog,last_modified(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri),R};
+echo(Info,Context,ErrorLog,TagList,ValueList,R) ->
+ {ok,Context,
+ [{internal_info,?NICE("echo directive has a spurious tag")}|
+ ErrorLog],"(none)",R}.
+
+document_name(Data,ConfigDB,RequestURI) ->
+ Path = mod_alias:path(Data,ConfigDB,RequestURI),
+ case regexp:match(Path,"[^/]*\$") of
+ {match,Start,Length} ->
+ string:substr(Path,Start,Length);
+ nomatch ->
+ "(none)"
+ end.
+
+document_uri(ConfigDB, RequestURI) ->
+ Aliases = httpd_util:multi_lookup(ConfigDB, alias),
+ {Path, AfterPath} =
+ case mod_alias:real_name(ConfigDB, RequestURI, Aliases) of
+ {_, Name, {[], []}} ->
+ {Name, ""};
+ {_, Name, {PathInfo, []}} ->
+ {Name, "/"++PathInfo};
+ {_, Name, {PathInfo, QueryString}} ->
+ {Name, "/"++PathInfo++"?"++QueryString};
+ {_, Name, _} ->
+ {Name, ""};
+ Gurka ->
+ io:format("Gurka: ~p~n", [Gurka])
+ end,
+ VirtualPath = string:substr(RequestURI, 1,
+ length(RequestURI)-length(AfterPath)),
+ {match, Start, Length} = regexp:match(Path,"[^/]*\$"),
+ FileName = string:substr(Path,Start,Length),
+ case regexp:match(VirtualPath, FileName++"\$") of
+ {match, _, _} ->
+ httpd_util:decode_hex(VirtualPath)++AfterPath;
+ nomatch ->
+ string:strip(httpd_util:decode_hex(VirtualPath),right,$/)++
+ "/"++FileName++AfterPath
+ end.
+
+query_string_unescaped(RequestURI) ->
+ case regexp:match(RequestURI,"[\?].*\$") of
+ {match,Start,Length} ->
+ %% Escape all shell-special variables with \
+ escape(string:substr(RequestURI,Start+1,Length-1));
+ nomatch ->
+ "(none)"
+ end.
+
+escape([]) -> [];
+escape([$;|R]) -> [$\\,$;|escape(R)];
+escape([$&|R]) -> [$\\,$&|escape(R)];
+escape([$(|R]) -> [$\\,$(|escape(R)];
+escape([$)|R]) -> [$\\,$)|escape(R)];
+escape([$||R]) -> [$\\,$||escape(R)];
+escape([$^|R]) -> [$\\,$^|escape(R)];
+escape([$<|R]) -> [$\\,$<|escape(R)];
+escape([$>|R]) -> [$\\,$>|escape(R)];
+escape([$\n|R]) -> [$\\,$\n|escape(R)];
+escape([$ |R]) -> [$\\,$ |escape(R)];
+escape([$\t|R]) -> [$\\,$\t|escape(R)];
+escape([C|R]) -> [C|escape(R)].
+
+date_local() ->
+ {{Year,Month,Day},{Hour,Minute,Second}}=calendar:local_time(),
+ %% Time format hard-wired to: "%a %b %e %T %Y" according to strftime(3)
+ io_lib:format("~s ~s ~2w ~2.2.0w:~2.2.0w:~2.2.0w ~w",
+ [httpd_util:day(calendar:day_of_the_week(Year,Month,Day)),
+ httpd_util:month(Month),Day,Hour,Minute,Second,Year]).
+
+date_gmt() ->
+ {{Year,Month,Day},{Hour,Minute,Second}}=calendar:universal_time(),
+ %% Time format hard-wired to: "%a %b %e %T %Z %Y" according to strftime(3)
+ io_lib:format("~s ~s ~2w ~2.2.0w:~2.2.0w:~2.2.0w GMT ~w",
+ [httpd_util:day(calendar:day_of_the_week(Year,Month,Day)),
+ httpd_util:month(Month),Day,Hour,Minute,Second,Year]).
+
+last_modified(Data,ConfigDB,RequestURI) ->
+ {ok,FileInfo}=file:read_file_info(mod_alias:path(Data,ConfigDB,RequestURI)),
+ {{Year,Month,Day},{Hour,Minute,Second}}=FileInfo#file_info.mtime,
+ io_lib:format("~s ~s ~2w ~2.2.0w:~2.2.0w:~2.2.0w ~w",
+ [httpd_util:day(calendar:day_of_the_week(Year,Month,Day)),
+ httpd_util:month(Month),Day,Hour,Minute,Second,Year]).
+
+%%
+%% fsize directive
+%%
+
+fsize(Info,Context,ErrorLog,[virtual],[VirtualPath],R) ->
+ Aliases=httpd_util:multi_lookup(Info#mod.config_db,alias),
+ {_,Path,AfterPath}=
+ mod_alias:real_name(Info#mod.config_db,VirtualPath,Aliases),
+ fsize(Info, Context, ErrorLog, R, Path);
+fsize(Info,Context,ErrorLog,[file],[FileName],R) ->
+ Path=file(Info#mod.config_db,Info#mod.request_uri,FileName),
+ fsize(Info,Context,ErrorLog,R,Path);
+fsize(Info,Context,ErrorLog,TagList,ValueList,R) ->
+ {ok,Context,[{internal_info,?NICE("fsize directive has a spurious tag")}|
+ ErrorLog],httpd_util:key1search(Context,errmsg,""),R}.
+
+fsize(Info,Context,ErrorLog,R,Path) ->
+ case file:read_file_info(Path) of
+ {ok,FileInfo} ->
+ case httpd_util:key1search(Context,sizefmt) of
+ "bytes" ->
+ {ok,Context,ErrorLog,
+ integer_to_list(FileInfo#file_info.size),R};
+ "abbrev" ->
+ Size = integer_to_list(trunc(FileInfo#file_info.size/1024+1))++"k",
+ {ok,Context,ErrorLog,Size,R};
+ Value->
+ {ok,Context,
+ [{internal_info,
+ ?NICE("fsize directive has a spurious tag value ("++
+ Value++")")}|
+ ErrorLog],
+ httpd_util:key1search(Context, errmsg, ""), R}
+ end;
+ {error,Reason} ->
+ {ok,Context,[{internal_info,?NICE("Can't open "++Path)}|ErrorLog],
+ httpd_util:key1search(Context,errmsg,""),R}
+ end.
+
+%%
+%% flastmod directive
+%%
+
+flastmod(Info, Context, ErrorLog, [virtual], [VirtualPath],R) ->
+ Aliases=httpd_util:multi_lookup(Info#mod.config_db,alias),
+ {_,Path,AfterPath}=
+ mod_alias:real_name(Info#mod.config_db,VirtualPath,Aliases),
+ flastmod(Info,Context,ErrorLog,R,Path);
+flastmod(Info, Context, ErrorLog, [file], [FileName], R) ->
+ Path = file(Info#mod.config_db, Info#mod.request_uri, FileName),
+ flastmod(Info, Context, ErrorLog, R, Path);
+flastmod(Info,Context,ErrorLog,TagList,ValueList,R) ->
+ {ok,Context,[{internal_info,?NICE("flastmod directive has a spurious tag")}|
+ ErrorLog],httpd_util:key1search(Context,errmsg,""),R}.
+
+flastmod(Info,Context,ErrorLog,R,File) ->
+ case file:read_file_info(File) of
+ {ok,FileInfo} ->
+ {{Yr,Mon,Day},{Hour,Minute,Second}}=FileInfo#file_info.mtime,
+ Result=
+ io_lib:format("~s ~s ~2w ~w:~w:~w ~w",
+ [httpd_util:day(
+ calendar:day_of_the_week(Yr,Mon, Day)),
+ httpd_util:month(Mon),Day,Hour,Minute,Second, Yr]),
+ {ok,Context,ErrorLog,Result,R};
+ {error,Reason} ->
+ {ok,Context,[{internal_info,?NICE("Can't open "++File)}|ErrorLog],
+ httpd_util:key1search(Context,errmsg,""),R}
+ end.
+
+%%
+%% exec directive
+%%
+
+exec(Info,Context,ErrorLog,[cmd],[Command],R) ->
+ ?vtrace("exec cmd:~n Command: ~p",[Command]),
+ cmd(Info,Context,ErrorLog,R,Command);
+exec(Info,Context,ErrorLog,[cgi],[RequestURI],R) ->
+ ?vtrace("exec cgi:~n RequestURI: ~p",[RequestURI]),
+ cgi(Info,Context,ErrorLog,R,RequestURI);
+exec(Info,Context,ErrorLog,TagList,ValueList,R) ->
+ ?vtrace("exec with spurious tag:"
+ "~n TagList: ~p"
+ "~n ValueList: ~p",
+ [TagList,ValueList]),
+ {ok, Context,
+ [{internal_info,?NICE("exec directive has a spurious tag")}|
+ ErrorLog], httpd_util:key1search(Context,errmsg,""),R}.
+
+%% cmd
+
+cmd(Info, Context, ErrorLog, R, Command) ->
+ process_flag(trap_exit,true),
+ Env = env(Info),
+ Dir = filename:dirname(Command),
+ Port = (catch open_port({spawn,Command},[stream,{cd,Dir},{env,Env}])),
+ case Port of
+ P when port(P) ->
+ {NewErrorLog, Result} = proxy(Port, ErrorLog),
+ {ok, Context, NewErrorLog, Result, R};
+ {'EXIT', Reason} ->
+ ?vlog("open port failed: exit"
+ "~n URI: ~p"
+ "~n Reason: ~p",
+ [Info#mod.request_uri,Reason]),
+ exit({open_port_failed,Reason,
+ [{uri,Info#mod.request_uri},{script,Command},
+ {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,
+ [{uri,Info#mod.request_uri},{script,Command},
+ {env,Env},{dir,Dir}]})
+ end.
+
+env(Info) ->
+ [{"DOCUMENT_NAME",document_name(Info#mod.data,Info#mod.config_db,
+ Info#mod.request_uri)},
+ {"DOCUMENT_URI", document_uri(Info#mod.config_db, Info#mod.request_uri)},
+ {"QUERY_STRING_UNESCAPED", query_string_unescaped(Info#mod.request_uri)},
+ {"DATE_LOCAL", date_local()},
+ {"DATE_GMT", date_gmt()},
+ {"LAST_MODIFIED", last_modified(Info#mod.data, Info#mod.config_db,
+ Info#mod.request_uri)}
+ ].
+
+%% cgi
+
+cgi(Info, Context, ErrorLog, R, RequestURI) ->
+ ScriptAliases = httpd_util:multi_lookup(Info#mod.config_db, script_alias),
+ case mod_alias:real_script_name(Info#mod.config_db, RequestURI,
+ ScriptAliases) of
+ {Script, AfterScript} ->
+ exec_script(Info,Script,AfterScript,ErrorLog,Context,R);
+ not_a_script ->
+ {ok, Context,
+ [{internal_info, ?NICE(RequestURI++" is not a script")}|
+ ErrorLog], httpd_util:key1search(Context, errmsg, ""),R}
+ end.
+
+remove_header([]) ->
+ [];
+remove_header([$\n,$\n|Rest]) ->
+ Rest;
+remove_header([C|Rest]) ->
+ remove_header(Rest).
+
+
+exec_script(Info,Script,AfterScript,ErrorLog,Context,R) ->
+ process_flag(trap_exit,true),
+ Aliases = httpd_util:multi_lookup(Info#mod.config_db, alias),
+ {_, Path, AfterPath} = mod_alias:real_name(Info#mod.config_db,
+ Info#mod.request_uri,
+ Aliases),
+ Env = env(Info)++mod_cgi:env(Info, Path, AfterPath),
+ Dir = filename:dirname(Path),
+ Port = (catch open_port({spawn,Script},[stream,{env, Env},{cd, Dir}])),
+ 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 ->
+ {NewErrorLog, Result} = proxy(Port, ErrorLog),
+ {ok, Context, NewErrorLog, remove_header(Result), R}
+ 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.
+
+
+%%
+%% Port communication
+%%
+
+proxy(Port,ErrorLog) ->
+ process_flag(trap_exit, true),
+ proxy(Port, ErrorLog, []).
+
+proxy(Port, ErrorLog, Result) ->
+ receive
+ {Port, {data, Response}} ->
+ proxy(Port, ErrorLog, lists:append(Result,Response));
+ {'EXIT', Port, normal} when port(Port) ->
+ process_flag(trap_exit, false),
+ {ErrorLog, Result};
+ {'EXIT', Port, Reason} when port(Port) ->
+ process_flag(trap_exit, false),
+ {[{internal_info,
+ ?NICE("Scrambled output from CGI-script")}|ErrorLog],
+ Result};
+ {'EXIT', Pid, Reason} when pid(Pid) ->
+ process_flag(trap_exit, false),
+ {'EXIT', Pid, Reason};
+ %% This should not happen!
+ WhatEver ->
+ process_flag(trap_exit, false),
+ {ErrorLog, Result}
+ end.
+
+
+%% ------
+%% Temporary until I figure out a way to fix send_in_chunks
+%% (comments and directives that start in one chunk but end
+%% in another is not handled).
+%%
+
+send_in(Info, Path,Head, {ok,FileInfo}) ->
+ case file:read_file(Path) of
+ {ok, Bin} ->
+ send_in1(Info, binary_to_list(Bin), Head, FileInfo);
+ {error, Reason} ->
+ ?vlog("failed reading file: ~p",[Reason]),
+ {error, {open,Reason}}
+ end;
+send_in(Info,Path,Head,{error,Reason}) ->
+ ?vlog("failed open file: ~p",[Reason]),
+ {error, {open,Reason}}.
+
+send_in1(Info, Data,Head,FileInfo) ->
+ {ok, _Context, Err, ParsedBody} = parse(Info,Data,?DEFAULT_CONTEXT,[],[]),
+ Size = length(ParsedBody),
+ ?vdebug("send_in1 -> Size: ~p",[Size]),
+ Head1 = case Info#mod.http_version of
+ "HTTP/1.1"->
+ Head ++
+ "Content-Length: " ++
+ integer_to_list(Size) ++
+ "\r\nEtag:" ++
+ httpd_util:create_etag(FileInfo,Size) ++"\r\n" ++
+ "Last-Modified: " ++
+ httpd_util:rfc1123_date(FileInfo#file_info.mtime) ++
+ "\r\n\r\n";
+ _->
+ %% i.e http/1.0 and http/0.9
+ Head ++
+ "Content-Length: " ++
+ integer_to_list(Size) ++
+ "\r\nLast-Modified: " ++
+ httpd_util:rfc1123_date(FileInfo#file_info.mtime) ++
+ "\r\n\r\n"
+ end,
+ httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,
+ [Head1,ParsedBody]),
+ {ok, Err, Size}.
+
+
+
+%%
+%% Addition to "Fuzzy" HTML parser. This is actually a ugly hack to
+%% avoid putting to much data on the heap. To be rewritten...
+%%
+
+% -define(CHUNK_SIZE, 4096).
+
+% send_in_chunks(Info, Path) ->
+% ?DEBUG("send_in_chunks -> Path: ~p",[Path]),
+% case file:open(Path, [read, raw]) of
+% {ok, Stream} ->
+% send_in_chunks(Info, Stream, ?DEFAULT_CONTEXT,[]);
+% {error, Reason} ->
+% ?ERROR("Failed open file: ~p",[Reason]),
+% {error, {open,Reason}}
+% end.
+
+% send_in_chunks(Info, Stream, Context, ErrorLog) ->
+% case file:read(Stream, ?CHUNK_SIZE) of
+% {ok, Data} ->
+% ?DEBUG("send_in_chunks -> read ~p bytes",[length(Data)]),
+% {ok, NewContext, NewErrorLog, ParsedBody}=
+% parse(Info, Data, Context, ErrorLog, []),
+% httpd_socket:deliver(Info#mod.socket_type,
+% Info#mod.socket, ParsedBody),
+% send_in_chunks(Info,Stream,NewContext,NewErrorLog);
+% eof ->
+% {ok, ErrorLog};
+% {error, Reason} ->
+% ?ERROR("Failed read from file: ~p",[Reason]),
+% {error, {read,Reason}}
+% end.
+
+
+%%
+%% "Fuzzy" HTML parser
+%%
+
+parse(Info,Body) ->
+ parse(Info, Body, ?DEFAULT_CONTEXT, [], []).
+
+parse(Info, [], Context, ErrorLog, Result) ->
+ {ok, Context, lists:reverse(ErrorLog), lists:reverse(Result)};
+parse(Info,[$<,$!,$-,$-,$#|R1],Context,ErrorLog,Result) ->
+ ?DEBUG("parse -> start command directive when length(R1): ~p",[length(R1)]),
+ case catch parse0(R1,Context) of
+ {parse_error,Reason} ->
+ parse(Info,R1,Context,[{internal_info,?NICE(Reason)}|ErrorLog],
+ [$#,$-,$-,$!,$<|Result]);
+ {ok,Context,Command,TagList,ValueList,R2} ->
+ ?DEBUG("parse -> Command: ~p",[Command]),
+ {ok,NewContext,NewErrorLog,MoreResult,R3}=
+ handle(Info,Context,ErrorLog,Command,TagList,ValueList,R2),
+ parse(Info,R3,NewContext,NewErrorLog,lists:reverse(MoreResult)++Result)
+ end;
+parse(Info,[$<,$!,$-,$-|R1],Context,ErrorLog,Result) ->
+ ?DEBUG("parse -> start comment when length(R1) = ~p",[length(R1)]),
+ case catch parse5(R1,[],0) of
+ {parse_error,Reason} ->
+ ?ERROR("parse -> parse error: ~p",[Reason]),
+ parse(Info,R1,Context,[{internal_info,?NICE(Reason)}|ErrorLog],Result);
+ {Comment,R2} ->
+ ?DEBUG("parse -> length(Comment) = ~p, length(R2) = ~p",
+ [length(Comment),length(R2)]),
+ parse(Info,R2,Context,ErrorLog,Comment++Result)
+ end;
+parse(Info,[C|R],Context,ErrorLog,Result) ->
+ parse(Info,R,Context,ErrorLog,[C|Result]).
+
+handle(Info,Context,ErrorLog,Command,TagList,ValueList,R) ->
+ case catch apply(?MODULE,Command,[Info,Context,ErrorLog,TagList,ValueList,
+ R]) of
+ {'EXIT',{undef,_}} ->
+ throw({parse_error,"Unknown command "++atom_to_list(Command)++
+ " in parsed doc"});
+ Result ->
+ Result
+ end.
+
+parse0([],Context) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse0([$-,$-,$>|R],Context) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse0([$ |R],Context) ->
+ parse0(R,Context);
+parse0(String,Context) ->
+ parse1(String,Context,"").
+
+parse1([],Context,Command) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse1([$-,$-,$>|R],Context,Command) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse1([$ |R],Context,Command) ->
+ parse2(R,Context,list_to_atom(lists:reverse(Command)),[],[],"");
+parse1([C|R],Context,Command) ->
+ parse1(R,Context,[C|Command]).
+
+parse2([],Context,Command,TagList,ValueList,Tag) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse2([$-,$-,$>|R],Context,Command,TagList,ValueList,Tag) ->
+ {ok,Context,Command,TagList,ValueList,R};
+parse2([$ |R],Context,Command,TagList,ValueList,Tag) ->
+ parse2(R,Context,Command,TagList,ValueList,Tag);
+parse2([$=|R],Context,Command,TagList,ValueList,Tag) ->
+ parse3(R,Context,Command,[list_to_atom(lists:reverse(Tag))|TagList],
+ ValueList);
+parse2([C|R],Context,Command,TagList,ValueList,Tag) ->
+ parse2(R,Context,Command,TagList,ValueList,[C|Tag]).
+
+parse3([],Context,Command,TagList,ValueList) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse3([$-,$-,$>|R],Context,Command,TagList,ValueList) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse3([$ |R],Context,Command,TagList,ValueList) ->
+ parse3(R,Context,Command,TagList,ValueList);
+parse3([$"|R],Context,Command,TagList,ValueList) ->
+ parse4(R,Context,Command,TagList,ValueList,"");
+parse3(String,Context,Command,TagList,ValueList) ->
+ throw({parse_error,"Premature EOF in parsed file"}).
+
+parse4([],Context,Command,TagList,ValueList,Value) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse4([$-,$-,$>|R],Context,Command,TagList,ValueList,Value) ->
+ throw({parse_error,"Premature EOF in parsed file"});
+parse4([$"|R],Context,Command,TagList,ValueList,Value) ->
+ parse2(R,Context,Command,TagList,[lists:reverse(Value)|ValueList],"");
+parse4([C|R],Context,Command,TagList,ValueList,Value) ->
+ parse4(R,Context,Command,TagList,ValueList,[C|Value]).
+
+parse5([],Comment,Depth) ->
+ ?ERROR("parse5 -> unterminated comment of ~p bytes when Depth = ~p",
+ [length(Comment),Depth]),
+ throw({parse_error,"Premature EOF in parsed file"});
+parse5([$<,$!,$-,$-|R],Comment,Depth) ->
+ parse5(R,[$-,$-,$!,$<|Comment],Depth+1);
+parse5([$-,$-,$>|R],Comment,0) ->
+ {">--"++Comment++"--!<",R};
+parse5([$-,$-,$>|R],Comment,Depth) ->
+ parse5(R,[$>,$-,$-|Comment],Depth-1);
+parse5([C|R],Comment,Depth) ->
+ parse5(R,[C|Comment],Depth).
+
+
+sz(B) when binary(B) -> {binary,size(B)};
+sz(L) when list(L) -> {list,length(L)};
+sz(_) -> undefined.
+
+
+%% send_error - Handle failure to send the file
+%%
+send_error({open,Reason},Info,Path) -> open_error(Reason,Info,Path);
+send_error({read,Reason},Info,Path) -> read_error(Reason,Info,Path).
+
+
+%% open_error - Handle file open failure
+%%
+open_error(eacces,Info,Path) ->
+ open_error(403,Info,Path,"");
+open_error(enoent,Info,Path) ->
+ open_error(404,Info,Path,"");
+open_error(enotdir,Info,Path) ->
+ open_error(404,Info,Path,
+ ": A component of the file name is not a directory");
+open_error(emfile,_Info,Path) ->
+ open_error(500,none,Path,": To many open files");
+open_error({enfile,_},_Info,Path) ->
+ open_error(500,none,Path,": File table overflow");
+open_error(_Reason,_Info,Path) ->
+ open_error(500,none,Path,"").
+
+open_error(StatusCode,none,Path,Reason) ->
+ {StatusCode,none,?NICE("Can't open "++Path++Reason)};
+open_error(StatusCode,Info,Path,Reason) ->
+ {StatusCode,Info#mod.request_uri,?NICE("Can't open "++Path++Reason)}.
+
+read_error(_Reason,_Info,Path) ->
+ read_error(500,none,Path,"").
+
+read_error(StatusCode,none,Path,Reason) ->
+ {StatusCode,none,?NICE("Can't read "++Path++Reason)};
+read_error(StatusCode,Info,Path,Reason) ->
+ {StatusCode,Info#mod.request_uri,?NICE("Can't read "++Path++Reason)}.
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_log.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_log.erl
new file mode 100644
index 0000000000..29fa2cfd11
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_log.erl
@@ -0,0 +1,250 @@
+%% ``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_log.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_log).
+-export([do/1,error_log/5,security_log/2,load/2,store/2,remove/1]).
+
+-export([report_error/2]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"LOG").
+-include("httpd_verbosity.hrl").
+
+%% do
+
+do(Info) ->
+ AuthUser = auth_user(Info#mod.data),
+ Date = custom_date(),
+ log_internal_info(Info,Date,Info#mod.data),
+ case httpd_util:key1search(Info#mod.data,status) of
+ %% A status code has been generated!
+ {StatusCode,PhraseArgs,Reason} ->
+ transfer_log(Info,"-",AuthUser,Date,StatusCode,0),
+ if
+ StatusCode >= 400 ->
+ error_log(Info,Date,Reason);
+ true ->
+ not_an_error
+ end,
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ {already_sent,StatusCode,Size} ->
+ transfer_log(Info,"-",AuthUser,Date,StatusCode,Size),
+ {proceed,Info#mod.data};
+ {response,Head,Body} ->
+ Size=httpd_util:key1search(Head,content_length,unknown),
+ Code=httpd_util:key1search(Head,code,unknown),
+ transfer_log(Info,"-",AuthUser,Date,Code,Size),
+ {proceed,Info#mod.data};
+ {StatusCode,Response} ->
+ transfer_log(Info,"-",AuthUser,Date,200,
+ httpd_util:flatlength(Response)),
+ {proceed,Info#mod.data};
+ undefined ->
+ transfer_log(Info,"-",AuthUser,Date,200,0),
+ {proceed,Info#mod.data}
+ end
+ end.
+
+custom_date() ->
+ LocalTime=calendar:local_time(),
+ UniversalTime=calendar:universal_time(),
+ Minutes=round(diff_in_minutes(LocalTime,UniversalTime)),
+ {{YYYY,MM,DD},{Hour,Min,Sec}}=LocalTime,
+ Date =
+ io_lib:format("~.2.0w/~.3s/~.4w:~.2.0w:~.2.0w:~.2.0w ~c~.2.0w~.2.0w",
+ [DD, httpd_util:month(MM), YYYY, Hour, Min, Sec,
+ sign(Minutes),
+ abs(Minutes) div 60, abs(Minutes) rem 60]),
+ lists:flatten(Date).
+
+diff_in_minutes(L,U) ->
+ (calendar:datetime_to_gregorian_seconds(L) -
+ calendar:datetime_to_gregorian_seconds(U))/60.
+
+sign(Minutes) when Minutes > 0 ->
+ $+;
+sign(Minutes) ->
+ $-.
+
+auth_user(Data) ->
+ case httpd_util:key1search(Data,remote_user) of
+ undefined ->
+ "-";
+ RemoteUser ->
+ RemoteUser
+ end.
+
+%% log_internal_info
+
+log_internal_info(Info,Date,[]) ->
+ ok;
+log_internal_info(Info,Date,[{internal_info,Reason}|Rest]) ->
+ error_log(Info,Date,Reason),
+ log_internal_info(Info,Date,Rest);
+log_internal_info(Info,Date,[_|Rest]) ->
+ log_internal_info(Info,Date,Rest).
+
+%% transfer_log
+
+transfer_log(Info,RFC931,AuthUser,Date,StatusCode,Bytes) ->
+ case httpd_util:lookup(Info#mod.config_db,transfer_log) of
+ undefined ->
+ no_transfer_log;
+ TransferLog ->
+ {PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+ case (catch io:format(TransferLog, "~s ~s ~s [~s] \"~s\" ~w ~w~n",
+ [RemoteHost, RFC931, AuthUser,
+ Date, Info#mod.request_line,
+ StatusCode, Bytes])) of
+ ok ->
+ ok;
+ Error ->
+ error_logger:error_report(Error)
+ end
+ end.
+
+%% security log
+
+security_log(Info, Reason) ->
+ case httpd_util:lookup(Info#mod.config_db, security_log) of
+ undefined ->
+ no_security_log;
+ SecurityLog ->
+ io:format(SecurityLog,"[~s] ~s~n", [custom_date(), Reason])
+ end.
+
+%% error_log
+
+error_log(Info,Date,Reason) ->
+ case httpd_util:lookup(Info#mod.config_db, error_log) of
+ undefined ->
+ no_error_log;
+ ErrorLog ->
+ {PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+ io:format(ErrorLog,"[~s] access to ~s failed for ~s, reason: ~p~n",
+ [Date,Info#mod.request_uri,RemoteHost,Reason])
+ end.
+
+error_log(SocketType,Socket,ConfigDB,{PortNumber,RemoteHost},Reason) ->
+ case httpd_util:lookup(ConfigDB,error_log) of
+ undefined ->
+ no_error_log;
+ ErrorLog ->
+ Date=custom_date(),
+ io:format(ErrorLog,"[~s] server crash for ~s, reason: ~p~n",
+ [Date,RemoteHost,Reason]),
+ ok
+ end.
+
+report_error(ConfigDB,Error) ->
+ case httpd_util:lookup(ConfigDB,error_log) of
+ undefined ->
+ no_error_log;
+ ErrorLog ->
+ Date=custom_date(),
+ io:format(ErrorLog,"[~s] reporting error: ~s~n",[Date,Error]),
+ ok
+ end.
+
+%%
+%% Configuration
+%%
+
+%% load
+
+load([$T,$r,$a,$n,$s,$f,$e,$r,$L,$o,$g,$ |TransferLog],[]) ->
+ {ok,[],{transfer_log,httpd_conf:clean(TransferLog)}};
+load([$E,$r,$r,$o,$r,$L,$o,$g,$ |ErrorLog],[]) ->
+ {ok,[],{error_log,httpd_conf:clean(ErrorLog)}};
+load([$S,$e,$c,$u,$r,$i,$t,$y,$L,$o,$g,$ |SecurityLog], []) ->
+ {ok, [], {security_log, httpd_conf:clean(SecurityLog)}}.
+
+%% store
+
+store({transfer_log,TransferLog},ConfigList) ->
+ case create_log(TransferLog,ConfigList) of
+ {ok,TransferLogStream} ->
+ {ok,{transfer_log,TransferLogStream}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({error_log,ErrorLog},ConfigList) ->
+ case create_log(ErrorLog,ConfigList) of
+ {ok,ErrorLogStream} ->
+ {ok,{error_log,ErrorLogStream}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({security_log, SecurityLog},ConfigList) ->
+ case create_log(SecurityLog, ConfigList) of
+ {ok, SecurityLogStream} ->
+ {ok, {security_log, SecurityLogStream}};
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+create_log(LogFile,ConfigList) ->
+ Filename = httpd_conf:clean(LogFile),
+ case filename:pathtype(Filename) of
+ absolute ->
+ case file:open(Filename, [read,write]) of
+ {ok,LogStream} ->
+ file:position(LogStream,{eof,0}),
+ {ok,LogStream};
+ {error,_} ->
+ {error,?NICE("Can't create "++Filename)}
+ end;
+ volumerelative ->
+ case file:open(Filename, [read,write]) of
+ {ok,LogStream} ->
+ file:position(LogStream,{eof,0}),
+ {ok,LogStream};
+ {error,_} ->
+ {error,?NICE("Can't create "++Filename)}
+ end;
+ relative ->
+ case httpd_util:key1search(ConfigList,server_root) of
+ undefined ->
+ {error,
+ ?NICE(Filename++
+ " is an invalid logfile name beacuse ServerRoot is not defined")};
+ ServerRoot ->
+ AbsoluteFilename=filename:join(ServerRoot,Filename),
+ case file:open(AbsoluteFilename, [read,write]) of
+ {ok,LogStream} ->
+ file:position(LogStream,{eof,0}),
+ {ok,LogStream};
+ {error,Reason} ->
+ {error,?NICE("Can't create "++AbsoluteFilename)}
+ end
+ end
+ end.
+
+%% remove
+
+remove(ConfigDB) ->
+ lists:foreach(fun([Stream]) -> file:close(Stream) end,
+ ets:match(ConfigDB,{transfer_log,'$1'})),
+ lists:foreach(fun([Stream]) -> file:close(Stream) end,
+ ets:match(ConfigDB,{error_log,'$1'})),
+ lists:foreach(fun([Stream]) -> file:close(Stream) end,
+ ets:match(ConfigDB,{security_log,'$1'})),
+ ok.
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_range.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_range.erl
new file mode 100644
index 0000000000..0728bd2d91
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_range.erl
@@ -0,0 +1,397 @@
+%% ``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_range.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_range).
+-export([do/1]).
+-include("httpd.hrl").
+
+%% do
+
+
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ case Info#mod.method of
+ "GET" ->
+ 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ case httpd_util:key1search(Info#mod.parsed_header,"range") of
+ undefined ->
+ %Not a range response
+ {proceed,Info#mod.data};
+ Range ->
+ %%Control that there weren't a if-range field that stopped
+ %%The range request in favor for the whole file
+ case httpd_util:key1search(Info#mod.data,if_range) of
+ send_file ->
+ {proceed,Info#mod.data};
+ _undefined ->
+ do_get_range(Info,Range)
+ end
+ end;
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end;
+ %% Not a GET method!
+ _ ->
+ {proceed,Info#mod.data}
+ end.
+
+do_get_range(Info,Ranges) ->
+ ?DEBUG("do_get_range -> Request URI: ~p",[Info#mod.request_uri]),
+ Path = mod_alias:path(Info#mod.data, Info#mod.config_db,
+ Info#mod.request_uri),
+ {FileInfo, LastModified} =get_modification_date(Path),
+ send_range_response(Path,Info,Ranges,FileInfo,LastModified).
+
+
+send_range_response(Path,Info,Ranges,FileInfo,LastModified)->
+ case parse_ranges(Ranges) of
+ error->
+ ?ERROR("send_range_response-> Unparsable range request",[]),
+ {proceed,Info#mod.data};
+ {multipart,RangeList}->
+ send_multi_range_response(Path,Info,RangeList);
+ {Start,Stop}->
+ send_range_response(Path,Info,Start,Stop,FileInfo,LastModified)
+ end.
+%%More than one range specified
+%%Send a multipart reponse to the user
+%
+%%An example of an multipart range response
+
+% HTTP/1.1 206 Partial Content
+% Date:Wed 15 Nov 1995 04:08:23 GMT
+% Last-modified:Wed 14 Nov 1995 04:08:23 GMT
+% Content-type: multipart/byteranges; boundary="SeparatorString"
+%
+% --"SeparatorString"
+% Content-Type: application/pdf
+% Content-Range: bytes 500-600/1010
+% .... The data..... 101 bytes
+%
+% --"SeparatorString"
+% Content-Type: application/pdf
+% Content-Range: bytes 700-1009/1010
+% .... The data.....
+
+
+
+send_multi_range_response(Path,Info,RangeList)->
+ case file:open(Path, [raw,binary]) of
+ {ok, FileDescriptor} ->
+ file:close(FileDescriptor),
+ ?DEBUG("send_multi_range_response -> FileDescriptor: ~p",[FileDescriptor]),
+ Suffix = httpd_util:suffix(Path),
+ PartMimeType = httpd_util:lookup_mime_default(Info#mod.config_db,Suffix,"text/plain"),
+ Date = httpd_util:rfc1123_date(),
+ {FileInfo,LastModified}=get_modification_date(Path),
+ case valid_ranges(RangeList,Path,FileInfo) of
+ {ValidRanges,true}->
+ ?DEBUG("send_multi_range_response -> Ranges are valid:",[]),
+ %Apache breaks the standard by sending the size field in the Header.
+ Header = [{code,206},
+ {content_type,"multipart/byteranges;boundary=RangeBoundarySeparator"},
+ {etag,httpd_util:create_etag(FileInfo)},
+ {last_modified,LastModified}
+ ],
+ ?DEBUG("send_multi_range_response -> Valid Ranges: ~p",[RagneList]),
+ Body={fun send_multiranges/4,[ValidRanges,Info,PartMimeType,Path]},
+ {proceed,[{response,{response,Header,Body}}|Info#mod.data]};
+ _ ->
+ {proceed, [{status, {416,"Range not valid",bad_range_boundaries }}]}
+ end;
+ {error, Reason} ->
+ ?ERROR("do_get -> failed open file: ~p",[Reason]),
+ {proceed,Info#mod.data}
+ end.
+
+send_multiranges(ValidRanges,Info,PartMimeType,Path)->
+ ?DEBUG("send_multiranges -> Start sending the ranges",[]),
+ case file:open(Path, [raw,binary]) of
+ {ok,FileDescriptor} ->
+ lists:foreach(fun(Range)->
+ send_multipart_start(Range,Info,PartMimeType,FileDescriptor)
+ end,ValidRanges),
+ file:close(FileDescriptor),
+ %%Sends an end of the multipart
+ httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,"\r\n--RangeBoundarySeparator--"),
+ sent;
+ _ ->
+ close
+ end.
+
+send_multipart_start({{Start,End},{StartByte,EndByte,Size}},Info,PartMimeType,FileDescriptor)when StartByte<Size->
+ PartHeader=["\r\n--RangeBoundarySeparator\r\n","Content-type: ",PartMimeType,"\r\n",
+ "Content-Range:bytes=",integer_to_list(StartByte),"-",integer_to_list(EndByte),"/",
+ integer_to_list(Size),"\r\n\r\n"],
+ send_part_start(Info#mod.socket_type,Info#mod.socket,PartHeader,FileDescriptor,Start,End);
+
+
+send_multipart_start({{Start,End},{StartByte,EndByte,Size}},Info,PartMimeType,FileDescriptor)->
+ PartHeader=["\r\n--RangeBoundarySeparator\r\n","Content-type: ",PartMimeType,"\r\n",
+ "Content-Range:bytes=",integer_to_list(Size-(StartByte-Size)),"-",integer_to_list(EndByte),"/",
+ integer_to_list(Size),"\r\n\r\n"],
+ send_part_start(Info#mod.socket_type,Info#mod.socket,PartHeader,FileDescriptor,Start,End).
+
+send_part_start(SocketType,Socket,PartHeader,FileDescriptor,Start,End)->
+ case httpd_socket:deliver(SocketType,Socket,PartHeader) of
+ ok ->
+ send_part_start(SocketType,Socket,FileDescriptor,Start,End);
+ _ ->
+ close
+ end.
+
+send_range_response(Path,Info,Start,Stop,FileInfo,LastModified)->
+ case file:open(Path, [raw,binary]) of
+ {ok, FileDescriptor} ->
+ file:close(FileDescriptor),
+ ?DEBUG("send_range_response -> FileDescriptor: ~p",[FileDescriptor]),
+ Suffix = httpd_util:suffix(Path),
+ MimeType = httpd_util:lookup_mime_default(Info#mod.config_db,Suffix,"text/plain"),
+ Date = httpd_util:rfc1123_date(),
+ Size = get_range_size(Start,Stop,FileInfo),
+ case valid_range(Start,Stop,FileInfo) of
+ {true,StartByte,EndByte,TotByte}->
+ Head=[{code,206},{content_type, MimeType},
+ {last_modified, LastModified},
+ {etag,httpd_util:create_etag(FileInfo)},
+ {content_range,["bytes=",integer_to_list(StartByte),"-",
+ integer_to_list(EndByte),"/",integer_to_list(TotByte)]},
+ {content_length,Size}],
+ BodyFunc=fun send_range_body/5,
+ Arg=[Info#mod.socket_type, Info#mod.socket,Path,Start,Stop],
+ {proceed,[{response,{response,Head,{BodyFunc,Arg}}}|Info#mod.data]};
+ {false,Reason} ->
+ {proceed, [{status, {416,Reason,bad_range_boundaries }}]}
+ end;
+ {error, Reason} ->
+ ?ERROR("send_range_response -> failed open file: ~p",[Reason]),
+ {proceed,Info#mod.data}
+ end.
+
+
+send_range_body(SocketType,Socket,Path,Start,End) ->
+ ?DEBUG("mod_range -> send_range_body",[]),
+ case file:open(Path, [raw,binary]) of
+ {ok,FileDescriptor} ->
+ send_part_start(SocketType,Socket,FileDescriptor,Start,End),
+ file:close(FileDescriptor);
+ _ ->
+ close
+ end.
+
+send_part_start(SocketType,Socket,FileDescriptor,Start,End) ->
+ case Start of
+ from_end ->
+ file:position(FileDescriptor,{eof,End}),
+ send_body(SocketType,Socket,FileDescriptor);
+ from_start ->
+ file:position(FileDescriptor,{bof,End}),
+ send_body(SocketType,Socket,FileDescriptor);
+ Byte when integer(Byte) ->
+ file:position(FileDescriptor,{bof,Start}),
+ send_part(SocketType,Socket,FileDescriptor,End)
+ end,
+ sent.
+
+
+%%This function could replace send_body by calling it with Start=0 end =FileSize
+%% But i gues it would be stupid when we look at performance
+send_part(SocketType,Socket,FileDescriptor,End)->
+ case file:position(FileDescriptor,{cur,0}) of
+ {ok,NewPos} ->
+ if
+ NewPos > End ->
+ ok;
+ true ->
+ Size=get_file_chunk_size(NewPos,End,?FILE_CHUNK_SIZE),
+ case file:read(FileDescriptor,Size) of
+ eof ->
+ ok;
+ {error,Reason} ->
+ ok;
+ {ok,Binary} ->
+ case httpd_socket:deliver(SocketType,Socket,Binary) of
+ socket_closed ->
+ ?LOG("send_range of body -> socket closed while sending",[]),
+ socket_close;
+ _ ->
+ send_part(SocketType,Socket,FileDescriptor,End)
+ end
+ end
+ end;
+ _->
+ ok
+ end.
+
+%% validate that the range is in the limits of the file
+valid_ranges(RangeList,Path,FileInfo)->
+ lists:mapfoldl(fun({Start,End},Acc)->
+ case Acc of
+ true ->
+ case valid_range(Start,End,FileInfo) of
+ {true,StartB,EndB,Size}->
+ {{{Start,End},{StartB,EndB,Size}},true};
+ _ ->
+ false
+ end;
+ _ ->
+ {false,false}
+ end
+ end,true,RangeList).
+
+
+
+valid_range(from_end,End,FileInfo)->
+ Size=FileInfo#file_info.size,
+ if
+ End < Size ->
+ {true,(Size+End),Size-1,Size};
+ true ->
+ false
+ end;
+valid_range(from_start,End,FileInfo)->
+ Size=FileInfo#file_info.size,
+ if
+ End < Size ->
+ {true,End,Size-1,Size};
+ true ->
+ false
+ end;
+
+valid_range(Start,End,FileInfo)when Start=<End->
+ case FileInfo#file_info.size of
+ FileSize when Start< FileSize ->
+ case FileInfo#file_info.size of
+ Size when End<Size ->
+ {true,Start,End,FileInfo#file_info.size};
+ Size ->
+ {true,Start,Size-1,Size}
+ end;
+ _->
+ {false,"The size of the range is negative"}
+ end;
+
+valid_range(Start,End,FileInfo)->
+ {false,"Range starts out of file boundaries"}.
+%% Find the modification date of the file
+get_modification_date(Path)->
+ case file:read_file_info(Path) of
+ {ok, FileInfo0} ->
+ {FileInfo0, httpd_util:rfc1123_date(FileInfo0#file_info.mtime)};
+ _ ->
+ {#file_info{},""}
+ end.
+
+%Calculate the size of the chunk to read
+
+get_file_chunk_size(Position,End,DefaultChunkSize)when (Position+DefaultChunkSize) =< End->
+ DefaultChunkSize;
+get_file_chunk_size(Position,End,DefaultChunkSize)->
+ (End-Position) +1.
+
+
+
+%Get the size of the range to send. Remember that
+%A range is from startbyte up to endbyte which means that
+%the nuber of byte in a range is (StartByte-EndByte)+1
+
+get_range_size(from_end,Stop,FileInfo)->
+ integer_to_list(-1*Stop);
+
+get_range_size(from_start,StartByte,FileInfo) ->
+ integer_to_list((((FileInfo#file_info.size)-StartByte)));
+
+get_range_size(StartByte,EndByte,FileInfo) ->
+ integer_to_list((EndByte-StartByte)+1).
+
+parse_ranges([$\ ,$b,$y,$t,$e,$s,$\=|Ranges])->
+ parse_ranges([$b,$y,$t,$e,$s,$\=|Ranges]);
+parse_ranges([$b,$y,$t,$e,$s,$\=|Ranges])->
+ case string:tokens(Ranges,", ") of
+ [Range] ->
+ parse_range(Range);
+ [Range1|SplittedRanges]->
+ {multipart,lists:map(fun parse_range/1,[Range1|SplittedRanges])}
+ end;
+%Bad unit
+parse_ranges(Ranges)->
+ io:format("Bad Ranges : ~p",[Ranges]),
+ error.
+%Parse the range specification from the request to {Start,End}
+%Start=End : Numreric string | []
+
+parse_range(Range)->
+ format_range(split_range(Range,[],[])).
+format_range({[],BytesFromEnd})->
+ {from_end,-1*(list_to_integer(BytesFromEnd))};
+format_range({StartByte,[]})->
+ {from_start,list_to_integer(StartByte)};
+format_range({StartByte,EndByte})->
+ {list_to_integer(StartByte),list_to_integer(EndByte)}.
+%Last case return the splitted range
+split_range([],Current,Other)->
+ {lists:reverse(Other),lists:reverse(Current)};
+
+split_range([$-|Rest],Current,Other)->
+ split_range(Rest,Other,Current);
+
+split_range([N|Rest],Current,End) ->
+ split_range(Rest,[N|Current],End).
+
+send_body(SocketType,Socket,FileDescriptor) ->
+ case file:read(FileDescriptor,?FILE_CHUNK_SIZE) of
+ {ok,Binary} ->
+ ?DEBUG("send_body -> send another chunk: ~p",[size(Binary)]),
+ case httpd_socket:deliver(SocketType,Socket,Binary) of
+ socket_closed ->
+ ?LOG("send_body -> socket closed while sending",[]),
+ socket_close;
+ _ ->
+ send_body(SocketType,Socket,FileDescriptor)
+ end;
+ eof ->
+ ?DEBUG("send_body -> done with this file",[]),
+ eof
+ end.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_responsecontrol.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_responsecontrol.erl
new file mode 100644
index 0000000000..c946098120
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_responsecontrol.erl
@@ -0,0 +1,337 @@
+%% ``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_responsecontrol.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+
+-module(mod_responsecontrol).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+
+do(Info) ->
+ ?DEBUG("do -> response_control",[]),
+ 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 ->
+ case httpd_util:key1search(Info#mod.data,response) of
+ %% No response has been generated!
+ undefined ->
+ case do_responsecontrol(Info) of
+ continue ->
+ {proceed,Info#mod.data};
+ Response ->
+ {proceed,[Response|Info#mod.data]}
+ end;
+ %% A response has been generated or sent!
+ Response ->
+ {proceed,Info#mod.data}
+ end
+ end.
+
+
+%%----------------------------------------------------------------------
+%%Control that the request header did not contians any limitations
+%%wheather a response shall be createed or not
+%%----------------------------------------------------------------------
+
+do_responsecontrol(Info) ->
+ ?DEBUG("do_response_control -> Request URI: ~p",[Info#mod.request_uri]),
+ Path = mod_alias:path(Info#mod.data, Info#mod.config_db,
+ Info#mod.request_uri),
+ case file:read_file_info(Path) of
+ {ok, FileInfo} ->
+ control(Path,Info,FileInfo);
+ _ ->
+ %% The requested asset is not a plain file and then it must
+ %% be generated everytime its requested
+ continue
+ end.
+
+%%----------------------------------------------------------------------
+%%Control the If-Match, If-None-Match, and If-Modified-Since
+%%----------------------------------------------------------------------
+
+
+%% If a client sends more then one of the if-XXXX fields in a request
+%% The standard says it does not specify the behaviuor so I specified it :-)
+%% The priority between the fields is
+%% 1.If-modified
+%% 2.If-Unmodified
+%% 3.If-Match
+%% 4.If-Nomatch
+
+%% This means if more than one of the fields are in the request the
+%% field with highest priority will be used
+
+%%If the request is a range request the If-Range field will be the winner.
+
+control(Path,Info,FileInfo)->
+ case control_range(Path,Info,FileInfo) of
+ undefined ->
+ case control_Etag(Path,Info,FileInfo) of
+ undefined ->
+ case control_modification(Path,Info,FileInfo) of
+ continue ->
+ continue;
+ ReturnValue ->
+ send_return_value(ReturnValue,FileInfo)
+ end;
+ continue ->
+ continue;
+ ReturnValue ->
+ send_return_value(ReturnValue,FileInfo)
+ end;
+ Response->
+ Response
+ end.
+
+%%----------------------------------------------------------------------
+%%If there are both a range and an if-range field control if
+%%----------------------------------------------------------------------
+control_range(Path,Info,FileInfo) ->
+ case httpd_util:key1search(Info#mod.parsed_header,"range") of
+ undefined->
+ undefined;
+ _Range ->
+ case httpd_util:key1search(Info#mod.parsed_header,"if-range") of
+ undefined ->
+ undefined;
+ EtagOrDate ->
+ control_if_range(Path,Info,FileInfo,EtagOrDate)
+ end
+ end.
+
+control_if_range(Path,Info,FileInfo,EtagOrDate) ->
+ case httpd_util:convert_request_date(strip_date(EtagOrDate)) of
+ bad_date ->
+ FileEtag=httpd_util:create_etag(FileInfo),
+ case FileEtag of
+ EtagOrDate ->
+ continue;
+ _ ->
+ {if_range,send_file}
+ end;
+ ErlDate ->
+ %%We got the date in the request if it is
+ case control_modification_data(Info,FileInfo#file_info.mtime,"if-range") of
+ modified ->
+ {if_range,send_file};
+ _UnmodifiedOrUndefined->
+ continue
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%%Controls the values of the If-Match and I-None-Mtch
+%%----------------------------------------------------------------------
+control_Etag(Path,Info,FileInfo)->
+ FileEtag=httpd_util:create_etag(FileInfo),
+ %%Control if the E-Tag for the resource matches one of the Etags in
+ %%the -if-match header field
+ case control_match(Info,FileInfo,"if-match",FileEtag) of
+ nomatch ->
+ %%None of the Etags in the if-match field matched the current
+ %%Etag for the resource return a 304
+ {412,Info,Path};
+ match ->
+ continue;
+ undefined ->
+ case control_match(Info,FileInfo,"if-none-match",FileEtag) of
+ nomatch ->
+ continue;
+ match ->
+ case Info#mod.method of
+ "GET" ->
+ {304,Info,Path};
+ "HEAD" ->
+ {304,Info,Path};
+ _OtherrequestMethod ->
+ {412,Info,Path}
+ end;
+ undefined ->
+ undefined
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%%Control if there are any Etags for HeaderField in the request if so
+%%Control if they match the Etag for the requested file
+%%----------------------------------------------------------------------
+control_match(Info,FileInfo,HeaderField,FileEtag)->
+ case split_etags(httpd_util:key1search(Info#mod.parsed_header,HeaderField)) of
+ undefined->
+ undefined;
+ Etags->
+ %%Control that the match any star not is availible
+ case lists:member("*",Etags) of
+ true->
+ match;
+ false->
+ compare_etags(FileEtag,Etags)
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%%Split the etags from the request
+%%----------------------------------------------------------------------
+split_etags(undefined)->
+ undefined;
+split_etags(Tags) ->
+ string:tokens(Tags,", ").
+
+%%----------------------------------------------------------------------
+%%Control if the etag for the file is in the list
+%%----------------------------------------------------------------------
+compare_etags(Tag,Etags) ->
+ case lists:member(Tag,Etags) of
+ true ->
+ match;
+ _ ->
+ nomatch
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%%Control if the file is modificated %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%----------------------------------------------------------------------
+%%Control the If-Modified-Since and If-Not-Modified-Since header fields
+%%----------------------------------------------------------------------
+control_modification(Path,Info,FileInfo)->
+ ?DEBUG("control_modification() -> entry",[]),
+ case control_modification_data(Info,FileInfo#file_info.mtime,"if-modified-since") of
+ modified->
+ continue;
+ unmodified->
+ {304,Info,Path};
+ undefined ->
+ case control_modification_data(Info,FileInfo#file_info.mtime,"if-unmodified-since") of
+ modified ->
+ {412,Info,Path};
+ _ContinueUndefined ->
+ continue
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%%Controls the date from the http-request if-modified-since and
+%%if-not-modified-since against the modification data of the
+%%File
+%%----------------------------------------------------------------------
+%%Info is the record about the request
+%%ModificationTime is the time the file was edited last
+%%Header Field is the name of the field to control
+
+control_modification_data(Info,ModificationTime,HeaderField)->
+ case strip_date(httpd_util:key1search(Info#mod.parsed_header,HeaderField)) of
+ undefined->
+ undefined;
+ LastModified0 ->
+ LastModified=httpd_util:convert_request_date(LastModified0),
+ ?DEBUG("control_modification_data() -> "
+ "~n Request-Field: ~s"
+ "~n FileLastModified: ~p"
+ "~n FieldValue: ~p",
+ [HeaderField,ModificationTime,LastModified]),
+ case LastModified of
+ bad_date ->
+ undefined;
+ _ ->
+ FileTime=calendar:datetime_to_gregorian_seconds(ModificationTime),
+ FieldTime=calendar:datetime_to_gregorian_seconds(LastModified),
+ if
+ FileTime=<FieldTime ->
+ ?DEBUG("File unmodified~n", []),
+ unmodified;
+ FileTime>=FieldTime ->
+ ?DEBUG("File modified~n", []),
+ modified
+ end
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%%Compare to dates on the form {{YYYY,MM,DD},{HH,MIN,SS}}
+%%If the first date is the biggest returns biggest1 (read biggestFirst)
+%%If the first date is smaller
+% compare_date(Date,bad_date)->
+% bad_date;
+
+% compare_date({D1,T1},{D2,T2})->
+% case compare_date1(D1,D2) of
+% equal ->
+% compare_date1(T1,T2);
+% GTorLT->
+% GTorLT
+% end.
+
+% compare_date1({T1,T2,T3},{T12,T22,T32}) when T1>T12 ->
+% bigger1;
+% compare_date1({T1,T2,T3},{T1,T22,T32}) when T2>T22 ->
+% bigger1;
+% compare_date1({T1,T2,T3},{T1,T2,T32}) when T3>T32 ->
+% bigger1;
+% compare_date1({T1,T2,T3},{T1,T2,T3})->
+% equal;
+% compare_date1(_D1,_D2)->
+% smaller1.
+
+
+%% IE4 & NS4 sends an extra '; length=xxxx' string at the end of the If-Modified-Since
+%% header, we detect this and ignore it (the RFCs does not mention this).
+strip_date(undefined) ->
+ undefined;
+strip_date([]) ->
+ [];
+strip_date([$;,$ |Rest]) ->
+ [];
+strip_date([C|Rest]) ->
+ [C|strip_date(Rest)].
+
+send_return_value({412,_,_},FileInfo)->
+ {status,{412,none,"Precondition Failed"}};
+
+send_return_value({304,Info,Path},FileInfo)->
+ Suffix=httpd_util:suffix(Path),
+ MimeType = httpd_util:lookup_mime_default(Info#mod.config_db,Suffix,"text/plain"),
+ Header = [{code,304},
+ {etag,httpd_util:create_etag(FileInfo)},
+ {content_length,0},
+ {last_modified,httpd_util:rfc1123_date(FileInfo#file_info.mtime)}],
+ {response,{response,Header,nobody}}.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security.erl
new file mode 100644
index 0000000000..14197979d1
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security.erl
@@ -0,0 +1,307 @@
+%% ``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_security.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
+%%
+-module(mod_security).
+
+%% Security Audit Functionality
+
+%% User API exports
+-export([list_blocked_users/1, list_blocked_users/2, list_blocked_users/3,
+ block_user/4, block_user/5,
+ unblock_user/2, unblock_user/3, unblock_user/4,
+ list_auth_users/1, list_auth_users/2, list_auth_users/3]).
+
+%% module API exports
+-export([do/1, load/2, store/2, remove/1]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"SEC").
+-include("httpd_verbosity.hrl").
+
+
+%% do/1
+do(Info) ->
+ ?vdebug("~n do with ~n Info: ~p",[Info]),
+ %% Check and see if any user has been authorized.
+ case httpd_util:key1search(Info#mod.data,remote_user,not_defined_user) of
+ not_defined_user ->
+ %% No user has been authorized.
+ case httpd_util:key1search(Info#mod.data, status) of
+ %% A status code has been generated!
+ {401, PhraseArgs, Reason} ->
+ case httpd_util:key1search(Info#mod.parsed_header,
+ "authorization") of
+ undefined ->
+ %% Not an authorization attempt (server just replied to
+ %% challenge for authentication)
+ {proceed, Info#mod.data};
+ [$B,$a,$s,$i,$c,$ |EncodedString] ->
+ %% Someone tried to authenticate, and obviously failed!
+ ?vlog("~n Authentication failed: ~s",
+ [EncodedString]),
+ report_failed(Info, EncodedString,"Failed authentication"),
+ take_failed_action(Info, EncodedString),
+ {proceed, Info#mod.data}
+ end;
+ _ ->
+ {proceed, Info#mod.data}
+ end;
+ User ->
+ %% A user has been authenticated, now is he blocked ?
+ ?vtrace("user '~p' authentication",[User]),
+ Path = mod_alias:path(Info#mod.data,
+ Info#mod.config_db,
+ Info#mod.request_uri),
+ {Dir, SDirData} = secretp(Path, Info#mod.config_db),
+ Addr = httpd_util:lookup(Info#mod.config_db, bind_address),
+ Port = httpd_util:lookup(Info#mod.config_db, port),
+ DF = httpd_util:key1search(SDirData, data_file),
+ case mod_security_server:check_blocked_user(Info, User,
+ SDirData,
+ Addr, Port) of
+ true ->
+ ?vtrace("user blocked",[]),
+ report_failed(Info,httpd_util:decode_base64(User) ,"User Blocked"),
+ {proceed, [{status, {403, Info#mod.request_uri, ""}}|Info#mod.data]};
+ false ->
+ ?vtrace("user not blocked",[]),
+ EncodedUser=httpd_util:decode_base64(User),
+ report_failed(Info, EncodedUser,"Authentication Succedded"),
+ mod_security_server:store_successful_auth(Addr, Port,
+ User, SDirData),
+ {proceed, Info#mod.data}
+ end
+ end.
+
+
+
+report_failed(Info, EncodedString,Event) ->
+ Request = Info#mod.request_line,
+ Decoded = httpd_util:decode_base64(EncodedString),
+ {PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+ String = RemoteHost++" : " ++ Event ++ " : "++Request++" : "++Decoded,
+ mod_disk_log:security_log(Info,String),
+ mod_log:security_log(Info, String).
+
+take_failed_action(Info, EncodedString) ->
+ Path = mod_alias:path(Info#mod.data,Info#mod.config_db, Info#mod.request_uri),
+ {Dir, SDirData} = secretp(Path, Info#mod.config_db),
+ Addr = httpd_util:lookup(Info#mod.config_db, bind_address),
+ Port = httpd_util:lookup(Info#mod.config_db, port),
+ DecodedString = httpd_util:decode_base64(EncodedString),
+ mod_security_server:store_failed_auth(Info, Addr, Port,
+ DecodedString, SDirData).
+
+secretp(Path, ConfigDB) ->
+ Directories = ets:match(ConfigDB,{directory,'$1','_'}),
+ case secret_path(Path, Directories) of
+ {yes, Directory} ->
+ SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory),
+ SDir = lists:filter(fun(X) ->
+ lists:member({path, Directory}, X)
+ end, SDirs0),
+ {Directory, lists:flatten(SDir)};
+ no ->
+ error_report({internal_error_secretp, ?MODULE}),
+ {[], []}
+ end.
+
+secret_path(Path,Directories) ->
+ secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found).
+
+secret_path(Path, [], to_be_found) ->
+ no;
+secret_path(Path, [], Directory) ->
+ {yes, Directory};
+secret_path(Path, [[NewDirectory]|Rest], Directory) ->
+ case regexp:match(Path, NewDirectory) of
+ {match, _, _} when Directory == to_be_found ->
+ secret_path(Path, Rest, NewDirectory);
+ {match, _, Length} when Length > length(Directory)->
+ secret_path(Path, Rest, NewDirectory);
+ {match, _, Length} ->
+ secret_path(Path, Rest, Directory);
+ nomatch ->
+ secret_path(Path, Rest, Directory)
+ end.
+
+
+load([$<,$D,$i,$r,$e,$c,$t,$o,$r,$y,$ |Directory],[]) ->
+ Dir = httpd_conf:custom_clean(Directory,"",">"),
+ {ok, [{security_directory, Dir, [{path, Dir}]}]};
+load(eof,[{security_directory,Directory, DirData}|_]) ->
+ {error, ?NICE("Premature end-of-file in "++Directory)};
+load([$S,$e,$c,$u,$r,$i,$t,$y,$D,$a,$t,$a,$F,$i,$l,$e,$ |FileName],
+ [{security_directory, Dir, DirData}]) ->
+ File = httpd_conf:clean(FileName),
+ {ok, [{security_directory, Dir, [{data_file, File}|DirData]}]};
+load([$S,$e,$c,$u,$r,$i,$t,$y,$C,$a,$l,$l,$b,$a,$c,$k,$M,$o,$d,$u,$l,$e,$ |ModuleName],
+ [{security_directory, Dir, DirData}]) ->
+ Mod = list_to_atom(httpd_conf:clean(ModuleName)),
+ {ok, [{security_directory, Dir, [{callback_module, Mod}|DirData]}]};
+load([$S,$e,$c,$u,$r,$i,$t,$y,$M,$a,$x,$R,$e,$t,$r,$i,$e,$s,$ |Retries],
+ [{security_directory, Dir, DirData}]) ->
+ MaxRetries = httpd_conf:clean(Retries),
+ load_return_int_tag("SecurityMaxRetries", max_retries,
+ httpd_conf:clean(Retries), Dir, DirData);
+load([$S,$e,$c,$u,$r,$i,$t,$y,$B,$l,$o,$c,$k,$T,$i,$m,$e,$ |Time],
+ [{security_directory, Dir, DirData}]) ->
+ load_return_int_tag("SecurityBlockTime", block_time,
+ httpd_conf:clean(Time), Dir, DirData);
+load([$S,$e,$c,$u,$r,$i,$t,$y,$F,$a,$i,$l,$E,$x,$p,$i,$r,$e,$T,$i,$m,$e,$ |Time],
+ [{security_directory, Dir, DirData}]) ->
+ load_return_int_tag("SecurityFailExpireTime", fail_expire_time,
+ httpd_conf:clean(Time), Dir, DirData);
+load([$S,$e,$c,$u,$r,$i,$t,$y,$A,$u,$t,$h,$T,$i,$m,$e,$o,$u,$t,$ |Time0],
+ [{security_directory, Dir, DirData}]) ->
+ Time = httpd_conf:clean(Time0),
+ load_return_int_tag("SecurityAuthTimeout", auth_timeout,
+ httpd_conf:clean(Time), Dir, DirData);
+load([$A,$u,$t,$h,$N,$a,$m,$e,$ |Name0],
+ [{security_directory, Dir, DirData}]) ->
+ Name = httpd_conf:clean(Name0),
+ {ok, [{security_directory, Dir, [{auth_name, Name}|DirData]}]};
+load("</Directory>",[{security_directory,Directory, DirData}]) ->
+ {ok, [], {security_directory, Directory, DirData}}.
+
+load_return_int_tag(Name, Atom, Time, Dir, DirData) ->
+ case Time of
+ "infinity" ->
+ {ok, [{security_directory, Dir, [{Atom, 99999999999999999999999999999}|DirData]}]};
+ Int ->
+ case catch list_to_integer(Time) of
+ {'EXIT', _} ->
+ {error, Time++" is an invalid "++Name};
+ Val ->
+ {ok, [{security_directory, Dir, [{Atom, Val}|DirData]}]}
+ end
+ end.
+
+store({security_directory, Dir0, DirData}, ConfigList) ->
+ ?CDEBUG("store(security_directory) -> ~n"
+ " Dir0: ~p~n"
+ " DirData: ~p",
+ [Dir0, DirData]),
+ Addr = httpd_util:key1search(ConfigList, bind_address),
+ Port = httpd_util:key1search(ConfigList, port),
+ mod_security_server:start(Addr, Port),
+ SR = httpd_util:key1search(ConfigList, server_root),
+ Dir =
+ case filename:pathtype(Dir0) of
+ relative ->
+ filename:join(SR, Dir0);
+ _ ->
+ Dir0
+ end,
+ case httpd_util:key1search(DirData, data_file, no_data_file) of
+ no_data_file ->
+ {error, no_security_data_file};
+ DataFile0 ->
+ DataFile =
+ case filename:pathtype(DataFile0) of
+ relative ->
+ filename:join(SR, DataFile0);
+ _ ->
+ DataFile0
+ end,
+ case mod_security_server:new_table(Addr, Port, DataFile) of
+ {ok, TwoTables} ->
+ NewDirData0 = lists:keyreplace(data_file, 1, DirData,
+ {data_file, TwoTables}),
+ NewDirData1 = case Addr of
+ undefined ->
+ [{port,Port}|NewDirData0];
+ _ ->
+ [{port,Port},{bind_address,Addr}|
+ NewDirData0]
+ end,
+ {ok, {security_directory,NewDirData1}};
+ {error, Err} ->
+ {error, {{open_data_file, DataFile}, Err}}
+ end
+ end.
+
+
+remove(ConfigDB) ->
+ Addr = case ets:lookup(ConfigDB, bind_address) of
+ [] ->
+ undefined;
+ [{bind_address, Address}] ->
+ Address
+ end,
+ [{port, Port}] = ets:lookup(ConfigDB, port),
+ mod_security_server:delete_tables(Addr, Port),
+ mod_security_server:stop(Addr, Port).
+
+
+%%
+%% User API
+%%
+
+%% list_blocked_users
+
+list_blocked_users(Port) ->
+ list_blocked_users(undefined, Port).
+
+list_blocked_users(Port, Dir) when integer(Port) ->
+ list_blocked_users(undefined,Port,Dir);
+list_blocked_users(Addr, Port) when integer(Port) ->
+ mod_security_server:list_blocked_users(Addr, Port).
+
+list_blocked_users(Addr, Port, Dir) ->
+ mod_security_server:list_blocked_users(Addr, Port, Dir).
+
+
+%% block_user
+
+block_user(User, Port, Dir, Time) ->
+ block_user(User, undefined, Port, Dir, Time).
+block_user(User, Addr, Port, Dir, Time) ->
+ mod_security_server:block_user(User, Addr, Port, Dir, Time).
+
+
+%% unblock_user
+
+unblock_user(User, Port) ->
+ unblock_user(User, undefined, Port).
+
+unblock_user(User, Port, Dir) when integer(Port) ->
+ unblock_user(User, undefined, Port, Dir);
+unblock_user(User, Addr, Port) when integer(Port) ->
+ mod_security_server:unblock_user(User, Addr, Port).
+
+unblock_user(User, Addr, Port, Dir) ->
+ mod_security_server:unblock_user(User, Addr, Port, Dir).
+
+
+%% list_auth_users
+
+list_auth_users(Port) ->
+ list_auth_users(undefined,Port).
+
+list_auth_users(Port, Dir) when integer(Port) ->
+ list_auth_users(undefined, Port, Dir);
+list_auth_users(Addr, Port) when integer(Port) ->
+ mod_security_server:list_auth_users(Addr, Port).
+
+list_auth_users(Addr, Port, Dir) ->
+ mod_security_server:list_auth_users(Addr, Port, Dir).
+
+
+error_report(M) ->
+ error_logger:error_report(M).
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl
new file mode 100644
index 0000000000..7df61df63e
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl
@@ -0,0 +1,728 @@
+%% ``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_security_server.erl,v 1.1 2008/12/17 09:53:36 mikpe Exp $
+%%
+%% Security Audit Functionality
+
+%%
+%% The gen_server code.
+%%
+%% A gen_server is needed in this module to take care of shared access to the
+%% data file used to store failed and successful authentications aswell as
+%% user blocks.
+%%
+%% The storage model is a write-through model with both an ets and a dets
+%% table. Writes are done to both the ets and then the dets table, but reads
+%% are only done from the ets table.
+%%
+%% This approach also enables parallelism when using dets by returning the
+%% same dets table identifier when opening several files with the same
+%% physical location.
+%%
+%% NOTE: This could be implemented using a single dets table, as it is
+%% possible to open a dets file with the ram_file flag, but this
+%% would require periodical sync's to disk, and it would be hard
+%% to decide when such an operation should occur.
+%%
+
+
+-module(mod_security_server).
+
+-include("httpd.hrl").
+-include("httpd_verbosity.hrl").
+
+
+-behaviour(gen_server).
+
+
+%% User API exports (called via mod_security)
+-export([list_blocked_users/2, list_blocked_users/3,
+ block_user/5,
+ unblock_user/3, unblock_user/4,
+ list_auth_users/2, list_auth_users/3]).
+
+%% Internal exports (for mod_security only)
+-export([start/2, stop/1, stop/2,
+ new_table/3, delete_tables/2,
+ store_failed_auth/5, store_successful_auth/4,
+ check_blocked_user/5]).
+
+%% gen_server exports
+-export([start_link/3,
+ init/1,
+ handle_info/2, handle_call/3, handle_cast/2,
+ terminate/2,
+ code_change/3]).
+
+-export([verbosity/3]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% External API %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% start_link/3
+%%
+%% NOTE: This is called by httpd_misc_sup when the process is started
+%%
+
+start_link(Addr, Port, Verbosity) ->
+ ?vtrace("start_link -> entry with"
+ "~n Addr: ~p"
+ "~n Port: ~p", [Addr, Port]),
+ Name = make_name(Addr, Port),
+ gen_server:start_link({local, Name}, ?MODULE, [Verbosity],
+ [{timeout, infinity}]).
+
+
+%% start/2
+%% Called by the mod_security module.
+
+start(Addr, Port) ->
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined ->
+ Verbosity = get(security_verbosity),
+ case httpd_misc_sup:start_sec_server(Addr, Port, Verbosity) of
+ {ok, Pid} ->
+ put(security_server, Pid),
+ ok;
+ Error ->
+ exit({failed_start_security_server, Error})
+ end;
+ _ -> %% Already started...
+ ok
+ end.
+
+
+%% stop
+
+stop(Port) ->
+ stop(undefined, Port).
+stop(Addr, Port) ->
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _ ->
+ httpd_misc_sup:stop_sec_server(Addr, Port)
+ end.
+
+
+%% verbosity
+
+verbosity(Addr, Port, Verbosity) ->
+ Name = make_name(Addr, Port),
+ Req = {verbosity, Verbosity},
+ call(Name, Req).
+
+
+%% list_blocked_users
+
+list_blocked_users(Addr, Port) ->
+ Name = make_name(Addr,Port),
+ Req = {list_blocked_users, Addr, Port, '_'},
+ call(Name, Req).
+
+list_blocked_users(Addr, Port, Dir) ->
+ Name = make_name(Addr, Port),
+ Req = {list_blocked_users, Addr, Port, Dir},
+ call(Name, Req).
+
+
+%% block_user
+
+block_user(User, Addr, Port, Dir, Time) ->
+ Name = make_name(Addr, Port),
+ Req = {block_user, User, Addr, Port, Dir, Time},
+ call(Name, Req).
+
+
+%% unblock_user
+
+unblock_user(User, Addr, Port) ->
+ Name = make_name(Addr, Port),
+ Req = {unblock_user, User, Addr, Port, '_'},
+ call(Name, Req).
+
+unblock_user(User, Addr, Port, Dir) ->
+ Name = make_name(Addr, Port),
+ Req = {unblock_user, User, Addr, Port, Dir},
+ call(Name, Req).
+
+
+%% list_auth_users
+
+list_auth_users(Addr, Port) ->
+ Name = make_name(Addr, Port),
+ Req = {list_auth_users, Addr, Port, '_'},
+ call(Name, Req).
+
+list_auth_users(Addr, Port, Dir) ->
+ Name = make_name(Addr,Port),
+ Req = {list_auth_users, Addr, Port, Dir},
+ call(Name, Req).
+
+
+%% new_table
+
+new_table(Addr, Port, TabName) ->
+ Name = make_name(Addr,Port),
+ Req = {new_table, Addr, Port, TabName},
+ call(Name, Req).
+
+
+%% delete_tables
+
+delete_tables(Addr, Port) ->
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _ ->
+ call(Name, delete_tables)
+ end.
+
+
+%% store_failed_auth
+
+store_failed_auth(Info, Addr, Port, DecodedString, SDirData) ->
+ Name = make_name(Addr,Port),
+ Msg = {store_failed_auth,[Info,DecodedString,SDirData]},
+ cast(Name, Msg).
+
+
+%% store_successful_auth
+
+store_successful_auth(Addr, Port, User, SDirData) ->
+ Name = make_name(Addr,Port),
+ Msg = {store_successful_auth, [User,Addr,Port,SDirData]},
+ cast(Name, Msg).
+
+
+%% check_blocked_user
+
+check_blocked_user(Info, User, SDirData, Addr, Port) ->
+ Name = make_name(Addr, Port),
+ Req = {check_blocked_user, [Info, User, SDirData]},
+ call(Name, Req).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Server call-back functions %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% init
+
+init([undefined]) ->
+ init([?default_verbosity]);
+init([Verbosity]) ->
+ ?DEBUG("init -> entry with Verbosity: ~p",[Verbosity]),
+ process_flag(trap_exit, true),
+ put(sname, sec),
+ put(verbosity, Verbosity),
+ ?vlog("starting",[]),
+ {ok, []}.
+
+
+%% handle_call
+
+handle_call(stop, _From, Tables) ->
+ ?vlog("stop",[]),
+ {stop, normal, ok, []};
+
+
+handle_call({verbosity,Verbosity}, _From, Tables) ->
+ ?vlog("set verbosity to ~p",[Verbosity]),
+ OldVerbosity = get(verbosity),
+ put(verbosity,Verbosity),
+ ?vdebug("old verbosity: ~p",[OldVerbosity]),
+ {reply,OldVerbosity,Tables};
+
+
+handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) ->
+ ?vlog("block user '~p' for ~p",[User,Dir]),
+ Ret = block_user_int({User, Addr, Port, Dir, Time}),
+ ?vdebug("block user result: ~p",[Ret]),
+ {reply, Ret, Tables};
+
+
+handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) ->
+ ?vlog("list blocked users for ~p",[Dir]),
+ Blocked = list_blocked(Tables, Addr, Port, Dir, []),
+ ?vdebug("list blocked users: ~p",[Blocked]),
+ {reply, Blocked, Tables};
+
+
+handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) ->
+ ?vlog("unblock user '~p' for ~p",[User,Dir]),
+ Ret = unblock_user_int({User, Addr, Port, Dir}),
+ ?vdebug("unblock user result: ~p",[Ret]),
+ {reply, Ret, Tables};
+
+
+handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) ->
+ ?vlog("list auth users for ~p",[Dir]),
+ Auth = list_auth(Tables, Addr, Port, Dir, []),
+ ?vdebug("list auth users result: ~p",[Auth]),
+ {reply, Auth, Tables};
+
+
+handle_call({new_table, Addr, Port, Name}, _From, Tables) ->
+ case lists:keysearch(Name, 1, Tables) of
+ {value, {Name, {Ets, Dets}}} ->
+ ?DEBUG("handle_call(new_table) -> we already have this table: ~p",
+ [Name]),
+ ?vdebug("new table; we already have this one: ~p",[Name]),
+ {reply, {ok, {Ets, Dets}}, Tables};
+ false ->
+ ?LOG("handle_call(new_table) -> new_table: Name = ~p",[Name]),
+ ?vlog("new table: ~p",[Name]),
+ TName = make_name(Addr,Port,length(Tables)),
+ ?DEBUG("handle_call(new_table) -> TName: ~p",[TName]),
+ ?vdebug("new table: ~p",[TName]),
+ case dets:open_file(TName, [{type, bag}, {file, Name},
+ {repair, true},
+ {access, read_write}]) of
+ {ok, DFile} ->
+ ETS = ets:new(TName, [bag, private]),
+ sync_dets_to_ets(DFile, ETS),
+ NewTables = [{Name, {ETS, DFile}}|Tables],
+ ?DEBUG("handle_call(new_table) -> ~n"
+ " NewTables: ~p",[NewTables]),
+ ?vtrace("new tables: ~p",[NewTables]),
+ {reply, {ok, {ETS, DFile}}, NewTables};
+ {error, Err} ->
+ ?LOG("handle_call -> Err: ~p",[Err]),
+ ?vinfo("failed open dets file: ~p",[Err]),
+ {reply, {error, {create_dets, Err}}, Tables}
+ end
+ end;
+
+handle_call(delete_tables, _From, Tables) ->
+ ?vlog("delete tables",[]),
+ lists:foreach(fun({Name, {ETS, DETS}}) ->
+ dets:close(DETS),
+ ets:delete(ETS)
+ end, Tables),
+ {reply, ok, []};
+
+handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) ->
+ ?vlog("check blocked user '~p'",[User]),
+ {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
+ Dir = httpd_util:key1search(SDirData, path),
+ Addr = httpd_util:key1search(SDirData, bind_address),
+ Port = httpd_util:key1search(SDirData, port),
+ CBModule = httpd_util:key1search(SDirData, callback_module, no_module_at_all),
+ ?vdebug("call back module: ~p",[CBModule]),
+ Ret = check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
+ ?vdebug("check result: ~p",[Ret]),
+ {reply, Ret, Tables};
+handle_call(Request,From,Tables) ->
+ ?vinfo("~n unknown call '~p' from ~p",[Request,From]),
+ {reply,ok,Tables}.
+
+
+%% handle_cast
+
+handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) ->
+ ?vlog("store failed auth",[]),
+ {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
+ Dir = httpd_util:key1search(SDirData, path),
+ Addr = httpd_util:key1search(SDirData, bind_address),
+ Port = httpd_util:key1search(SDirData, port),
+ {ok, [User,Password]} = httpd_util:split(DecodedString,":",2),
+ ?vdebug("user '~p' and password '~p'",[User,Password]),
+ Seconds = universal_time(),
+ Key = {User, Dir, Addr, Port},
+
+ %% Event
+ CBModule = httpd_util:key1search(SDirData, callback_module, no_module_at_all),
+ ?vtrace("call back module: ~p",[CBModule]),
+ auth_fail_event(CBModule,Addr,Port,Dir,User,Password),
+
+ %% Find out if any of this user's other failed logins are too old to keep..
+ ?vtrace("remove old login failures",[]),
+ case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
+ [] ->
+ ?vtrace("no old login failures",[]),
+ no;
+ List when list(List) ->
+ ?vtrace("~p old login failures",[length(List)]),
+ ExpireTime = httpd_util:key1search(SDirData, fail_expire_time, 30)*60,
+ ?vtrace("expire time ~p",[ExpireTime]),
+ lists:map(fun({failed, {TheKey, LS, Gen}}) ->
+ Diff = Seconds-LS,
+ if
+ Diff > ExpireTime ->
+ ?vtrace("~n '~p' is to old to keep: ~p",
+ [TheKey,Gen]),
+ ets:match_delete(ETS, {failed, {TheKey, LS, Gen}}),
+ dets:match_delete(DETS, {failed, {TheKey, LS, Gen}});
+ true ->
+ ?vtrace("~n '~p' is not old enough: ~p",
+ [TheKey,Gen]),
+ ok
+ end
+ end,
+ List);
+ O ->
+ ?vlog("~n unknown login failure search resuylt: ~p",[O]),
+ no
+ end,
+
+ %% Insert the new failure..
+ Generation = length(ets:match_object(ETS, {failed, {Key, '_', '_'}})),
+ ?vtrace("insert ('~p') new login failure: ~p",[Key,Generation]),
+ ets:insert(ETS, {failed, {Key, Seconds, Generation}}),
+ dets:insert(DETS, {failed, {Key, Seconds, Generation}}),
+
+ %% See if we should block this user..
+ MaxRetries = httpd_util:key1search(SDirData, max_retries, 3),
+ BlockTime = httpd_util:key1search(SDirData, block_time, 60),
+ ?vtrace("~n Max retries ~p, block time ~p",[MaxRetries,BlockTime]),
+ case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
+ List1 ->
+ ?vtrace("~n ~p tries so far",[length(List1)]),
+ if
+ length(List1) >= MaxRetries ->
+ %% Block this user until Future
+ ?vtrace("block user '~p'",[User]),
+ Future = Seconds+BlockTime*60,
+ ?vtrace("future: ~p",[Future]),
+ Reason = io_lib:format("Blocking user ~s from dir ~s "
+ "for ~p minutes",
+ [User, Dir, BlockTime]),
+ mod_log:security_log(Info, lists:flatten(Reason)),
+
+ %% Event
+ user_block_event(CBModule,Addr,Port,Dir,User),
+
+ ets:match_delete(ETS,{blocked_user,
+ {User, Addr, Port, Dir, '$1'}}),
+ dets:match_delete(DETS, {blocked_user,
+ {User, Addr, Port, Dir, '$1'}}),
+ BlockRecord = {blocked_user,
+ {User, Addr, Port, Dir, Future}},
+ ets:insert(ETS, BlockRecord),
+ dets:insert(DETS, BlockRecord),
+ %% Remove previous failed requests.
+ ets:match_delete(ETS, {failed, {Key, '_', '_'}}),
+ dets:match_delete(DETS, {failed, {Key, '_', '_'}});
+ true ->
+ ?vtrace("still some tries to go",[]),
+ no
+ end;
+ Other ->
+ no
+ end,
+ {noreply, Tables};
+
+handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) ->
+ ?vlog("store successfull auth",[]),
+ {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
+ AuthTimeOut = httpd_util:key1search(SDirData, auth_timeout, 30),
+ Dir = httpd_util:key1search(SDirData, path),
+ Key = {User, Dir, Addr, Port},
+
+ %% Remove failed entries for this Key
+ dets:match_delete(DETS, {failed, {Key, '_', '_'}}),
+ ets:match_delete(ETS, {failed, {Key, '_', '_'}}),
+
+ %% Keep track of when the last successful login took place.
+ Seconds = universal_time()+AuthTimeOut,
+ ets:match_delete(ETS, {success, {Key, '_'}}),
+ dets:match_delete(DETS, {success, {Key, '_'}}),
+ ets:insert(ETS, {success, {Key, Seconds}}),
+ dets:insert(DETS, {success, {Key, Seconds}}),
+ {noreply, Tables};
+
+handle_cast(Req, Tables) ->
+ ?vinfo("~n unknown cast '~p'",[Req]),
+ error_msg("security server got unknown cast: ~p",[Req]),
+ {noreply, Tables}.
+
+
+%% handle_info
+
+handle_info(Info, State) ->
+ ?vinfo("~n unknown info '~p'",[Info]),
+ {noreply, State}.
+
+
+%% terminate
+
+terminate(Reason, _Tables) ->
+ ?vlog("~n Terminating for reason: ~p",[Reason]),
+ ok.
+
+
+%% code_change({down, ToVsn}, State, Extra)
+%%
+code_change({down, _}, State, _Extra) ->
+ ?vlog("downgrade", []),
+ {ok, State};
+
+
+%% code_change(FromVsn, State, Extra)
+%%
+code_change(_, State, Extra) ->
+ ?vlog("upgrade", []),
+ {ok, State}.
+
+
+
+
+%% block_user_int/2
+block_user_int({User, Addr, Port, Dir, Time}) ->
+ Dirs = httpd_manager:config_match(Addr, Port, {security_directory, '_'}),
+ ?vtrace("block '~p' for ~p during ~p",[User,Dir,Time]),
+ case find_dirdata(Dirs, Dir) of
+ {ok, DirData, {ETS, DETS}} ->
+ Time1 =
+ case Time of
+ infinity ->
+ 99999999999999999999999999999;
+ _ ->
+ Time
+ end,
+ Future = universal_time()+Time1,
+ ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Dir,'_'}}),
+ dets:match_delete(DETS, {blocked_user, {User,Addr,Port,Dir,'_'}}),
+ ets:insert(ETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
+ dets:insert(DETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
+ CBModule = httpd_util:key1search(DirData, callback_module,
+ no_module_at_all),
+ ?vtrace("call back module ~p",[CBModule]),
+ user_block_event(CBModule,Addr,Port,Dir,User),
+ true;
+ _ ->
+ {error, no_such_directory}
+ end.
+
+
+find_dirdata([], _Dir) ->
+ false;
+find_dirdata([{security_directory, DirData}|SDirs], Dir) ->
+ case lists:keysearch(path, 1, DirData) of
+ {value, {path, Dir}} ->
+ {value, {data_file, {ETS, DETS}}} =
+ lists:keysearch(data_file, 1, DirData),
+ {ok, DirData, {ETS, DETS}};
+ _ ->
+ find_dirdata(SDirs, Dir)
+ end.
+
+%% unblock_user_int/2
+
+unblock_user_int({User, Addr, Port, Dir}) ->
+ ?vtrace("unblock user '~p' for ~p",[User,Dir]),
+ Dirs = httpd_manager:config_match(Addr, Port, {security_directory, '_'}),
+ ?vtrace("~n dirs: ~p",[Dirs]),
+ case find_dirdata(Dirs, Dir) of
+ {ok, DirData, {ETS, DETS}} ->
+ case ets:match_object(ETS,{blocked_user,{User,Addr,Port,Dir,'_'}}) of
+ [] ->
+ ?vtrace("not blocked",[]),
+ {error, not_blocked};
+ Objects ->
+ ets:match_delete(ETS, {blocked_user,
+ {User, Addr, Port, Dir, '_'}}),
+ dets:match_delete(DETS, {blocked_user,
+ {User, Addr, Port, Dir, '_'}}),
+ CBModule = httpd_util:key1search(DirData, callback_module,
+ no_module_at_all),
+ user_unblock_event(CBModule,Addr,Port,Dir,User),
+ true
+ end;
+ _ ->
+ ?vlog("~n cannot unblock: no such directory '~p'",[Dir]),
+ {error, no_such_directory}
+ end.
+
+
+
+%% list_auth/2
+
+list_auth([], _Addr, _Port, Dir, Acc) ->
+ Acc;
+list_auth([{Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) ->
+ case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port}, '_'}}) of
+ [] ->
+ list_auth(Tables, Addr, Port, Dir, Acc);
+ List when list(List) ->
+ TN = universal_time(),
+ NewAcc = lists:foldr(fun({success,{{U,Ad,P,D},T}},Ac) ->
+ if
+ T-TN > 0 ->
+ [U|Ac];
+ true ->
+ Rec = {success,{{U,Ad,P,D},T}},
+ ets:match_delete(ETS,Rec),
+ dets:match_delete(DETS,Rec),
+ Ac
+ end
+ end,
+ Acc, List),
+ list_auth(Tables, Addr, Port, Dir, NewAcc);
+ _ ->
+ list_auth(Tables, Addr, Port, Dir, Acc)
+ end.
+
+
+%% list_blocked/2
+
+list_blocked([], Addr, Port, Dir, Acc) ->
+ TN = universal_time(),
+ lists:foldl(fun({U,Ad,P,D,T}, Ac) ->
+ if
+ T-TN > 0 ->
+ [{U,Ad,P,D,local_time(T)}|Ac];
+ true ->
+ Ac
+ end
+ end,
+ [], Acc);
+list_blocked([{Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) ->
+ NewBlocked =
+ case ets:match_object(ETS, {blocked_user, {'_',Addr,Port,Dir,'_'}}) of
+ List when list(List) ->
+ lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, Acc, List);
+ _ ->
+ Acc
+ end,
+ list_blocked(Tables, Addr, Port, Dir, NewBlocked).
+
+
+%%
+%% sync_dets_to_ets/2
+%%
+%% Reads dets-table DETS and syncronizes it with the ets-table ETS.
+%%
+sync_dets_to_ets(DETS, ETS) ->
+ dets:traverse(DETS, fun(X) ->
+ ets:insert(ETS, X),
+ continue
+ end).
+
+%%
+%% check_blocked_user/7 -> true | false
+%%
+%% Check if a specific user is blocked from access.
+%%
+%% The sideeffect of this routine is that it unblocks also other users
+%% whos blocking time has expired. This to keep the tables as small
+%% as possible.
+%%
+check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
+ TN = universal_time(),
+ case ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}) of
+ List when list(List) ->
+ Blocked = lists:foldl(fun({blocked_user, X}, A) ->
+ [X|A] end, [], List),
+ check_blocked_user(Info,User,Dir,Addr,Port,ETS,DETS,TN,Blocked,CBModule);
+ _ ->
+ false
+ end.
+check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, [], CBModule) ->
+ false;
+check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN,
+ [{User,Addr,Port,Dir,T}|Ls], CBModule) ->
+ TD = T-TN,
+ if
+ TD =< 0 ->
+ %% Blocking has expired, remove and grant access.
+ unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
+ false;
+ true ->
+ true
+ end;
+check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN,
+ [{OUser,ODir,OAddr,OPort,T}|Ls], CBModule) ->
+ TD = T-TN,
+ if
+ TD =< 0 ->
+ %% Blocking has expired, remove.
+ unblock_user(Info, OUser, ODir, OAddr, OPort, ETS, DETS, CBModule);
+ true ->
+ true
+ end,
+ check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, Ls, CBModule).
+
+unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
+ Reason=io_lib:format("User ~s was removed from the block list for dir ~s",
+ [User, Dir]),
+ mod_log:security_log(Info, lists:flatten(Reason)),
+ user_unblock_event(CBModule,Addr,Port,Dir,User),
+ dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '_'}}),
+ ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Dir, '_'}}).
+
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd_security",Addr,Port).
+
+make_name(Addr,Port,Num) ->
+ httpd_util:make_name("httpd_security",Addr,Port,
+ "__" ++ integer_to_list(Num)).
+
+
+auth_fail_event(Mod,Addr,Port,Dir,User,Passwd) ->
+ event(auth_fail,Mod,Addr,Port,Dir,[{user,User},{password,Passwd}]).
+
+user_block_event(Mod,Addr,Port,Dir,User) ->
+ event(user_block,Mod,Addr,Port,Dir,[{user,User}]).
+
+user_unblock_event(Mod,Addr,Port,Dir,User) ->
+ event(user_unblock,Mod,Addr,Port,Dir,[{user,User}]).
+
+event(Event,Mod,undefined,Port,Dir,Info) ->
+ (catch Mod:event(Event,Port,Dir,Info));
+event(Event,Mod,Addr,Port,Dir,Info) ->
+ (catch Mod:event(Event,Addr,Port,Dir,Info)).
+
+universal_time() ->
+ calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
+
+local_time(T) ->
+ calendar:universal_time_to_local_time(
+ calendar:gregorian_seconds_to_datetime(T)).
+
+
+error_msg(F, A) ->
+ error_logger:error_msg(F, A).
+
+
+call(Name, Req) ->
+ case (catch gen_server:call(Name, Req)) of
+ {'EXIT', Reason} ->
+ {error, Reason};
+ Reply ->
+ Reply
+ end.
+
+
+cast(Name, Msg) ->
+ case (catch gen_server:cast(Name, Msg)) of
+ {'EXIT', Reason} ->
+ {error, Reason};
+ Result ->
+ Result
+ end.
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_trace.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_trace.erl
new file mode 100644
index 0000000000..51fe6d283a
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_trace.erl
@@ -0,0 +1,69 @@
+%% ``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_trace.erl,v 1.1 2008/12/17 09:53:36 mikpe Exp $
+%%
+-module(mod_trace).
+
+-export([do/1]).
+
+-include("httpd.hrl").
+
+
+do(Info) ->
+ %%?vtrace("do",[]),
+ case Info#mod.method of
+ "TRACE" ->
+ case httpd_util:response_generated(Info) of
+ false->
+ generate_trace_response(Info);
+ true->
+ {proceed,Info#mod.data}
+ end;
+ _ ->
+ {proceed,Info#mod.data}
+ end.
+
+
+%%---------------------------------------------------------------------
+%%Generate the trace response the trace response consists of a
+%%http-header and the body will be the request.
+%5----------------------------------------------------------------------
+
+generate_trace_response(Info)->
+ RequestHead=Info#mod.parsed_header,
+ Body=generate_trace_response_body(RequestHead),
+ Len=length(Body),
+ Response=["HTTP/1.1 200 OK\r\n",
+ "Content-Type:message/http\r\n",
+ "Content-Length:",integer_to_list(Len),"\r\n\r\n",
+ Info#mod.request_line,Body],
+ httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,Response),
+ {proceed,[{response,{already_sent,200,Len}}|Info#mod.data]}.
+
+generate_trace_response_body(Parsed_header)->
+ generate_trace_response_body(Parsed_header,[]).
+
+generate_trace_response_body([],Head)->
+ lists:flatten(Head);
+generate_trace_response_body([{[],[]}|Rest],Head) ->
+ generate_trace_response_body(Rest,Head);
+generate_trace_response_body([{Field,Value}|Rest],Head) ->
+ generate_trace_response_body(Rest,[Field ++ ":" ++ Value ++ "\r\n"|Head]).
+
+
+
+
+
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/uri.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/uri.erl
new file mode 100644
index 0000000000..e1acd62a31
--- /dev/null
+++ b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/uri.erl
@@ -0,0 +1,349 @@
+%% ``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 Mobile Arts AB
+%% Portions created by Mobile Arts are Copyright 2002, Mobile Arts AB
+%% All Rights Reserved.''
+%%
+%%
+%% Author : Johan Blom <[email protected]>
+%% Description :
+%% Implements various scheme dependent subsets (e.g. HTTP, FTP etc) based on
+%% RFC 2396, Uniform Resource Identifiers (URI): Generic Syntax
+%% Created : 27 Jul 2001 by Johan Blom <[email protected]>
+%%
+
+-module(uri).
+
+-author('[email protected]').
+
+-export([parse/1,resolve/2]).
+
+
+%%% Parse URI and return {Scheme,Path}
+%%% Note that Scheme specific parsing/validation is not handled here!
+resolve(Root,Rel) ->
+ ok.
+
+%%% See "http://www.isi.edu/in-notes/iana/assignments/url-schemes" for a list of
+%%% defined URL schemes and references to its sources.
+
+parse(URI) ->
+ case parse_scheme(URI) of
+ {http,Cont} -> parse_http(Cont,http);
+ {https,Cont} -> parse_http(Cont,https);
+ {ftp,Cont} -> parse_ftp(Cont,ftp);
+ {sip,Cont} -> parse_sip(Cont,sip);
+ {sms,Cont} -> parse_sms(Cont,sip);
+ {error,Error} -> {error,Error};
+ {Scheme,Cont} -> {Scheme,Cont}
+ end.
+
+
+%%% Parse the scheme.
+parse_scheme(URI) ->
+ parse_scheme(URI,[]).
+
+parse_scheme([H|URI],Acc) when $a=<H,H=<$z; $A=<H,H=<$Z ->
+ parse_scheme2(URI,[H|Acc]);
+parse_scheme(_,_) ->
+ {error,no_scheme}.
+
+parse_scheme2([H|URI],Acc)
+ when $a=<H,H=<$z; $A=<H,H=<$Z; $0=<H,H=<$9; H==$-;H==$+;H==$. ->
+ parse_scheme2(URI,[H|Acc]);
+parse_scheme2([$:|URI],Acc) ->
+ {list_to_atom(lists:reverse(Acc)),URI};
+parse_scheme2(_,_) ->
+ {error,no_scheme}.
+
+
+%%% ............................................................................
+-define(HTTP_DEFAULT_PORT, 80).
+-define(HTTPS_DEFAULT_PORT, 443).
+
+%%% HTTP (Source RFC 2396, RFC 2616)
+%%% http_URL = "*" | absoluteURI | abs_path [ "?" query ] | authority
+
+%%% http_URL = "http:" "//" host [ ":" port ] [ abs_path [ "?" query ]]
+%%% Returns a tuple {http,Host,Port,PathQuery} where
+%%% Host = string() Host value
+%%% Port = string() Port value
+%%% PathQuery= string() Combined absolute path and query value
+parse_http("//"++C0,Scheme) ->
+ case scan_hostport(C0,Scheme) of
+ {C1,Host,Port} ->
+ case scan_pathquery(C1) of
+ {error,Error} ->
+ {error,Error};
+ PathQuery ->
+ {Scheme,Host,Port,PathQuery}
+ end;
+ {error,Error} ->
+ {error,Error}
+ end;
+parse_http(_,_) ->
+ {error,invalid_url}.
+
+scan_pathquery(C0) ->
+ case scan_abspath(C0) of
+ {error,Error} ->
+ {error,Error};
+ {[],[]} -> % Add implicit path
+ "/";
+ {"?"++C1,Path} ->
+ case scan_query(C1,[]) of
+ {error,Error} ->
+ {error,Error};
+ Query ->
+ Path++"?"++Query
+ end;
+ {[],Path} ->
+ Path
+ end.
+
+
+%%% ............................................................................
+%%% FIXME!!! This is just a quick hack that doesn't work!
+-define(FTP_DEFAULT_PORT, 80).
+
+%%% FTP (Source RFC 2396, RFC 1738, RFC 959)
+%%% Note: This BNF has been modified to better fit with RFC 2396
+%%% ftp_URL = "ftp:" "//" [ ftp_userinfo ] host [ ":" port ] ftp_abs_path
+%%% ftp_userinfo = ftp_user [ ":" ftp_password ]
+%%% ftp_abs_path = "/" ftp_path_segments [ ";type=" ftp_type ]
+%%% ftp_path_segments = ftp_segment *( "/" ftp_segment)
+%%% ftp_segment = *[ ftp_uchar | "?" | ":" | "@" | "&" | "=" ]
+%%% ftp_type = "A" | "I" | "D" | "a" | "i" | "d"
+%%% ftp_user = *[ ftp_uchar | ";" | "?" | "&" | "=" ]
+%%% ftp_password = *[ ftp_uchar | ";" | "?" | "&" | "=" ]
+%%% ftp_uchar = ftp_unreserved | escaped
+%%% ftp_unreserved = alphanum | mark | "$" | "+" | ","
+parse_ftp("//"++C0,Scheme) ->
+ case ftp_userinfo(C0) of
+ {C1,Creds} ->
+ case scan_hostport(C1,Scheme) of
+ {C2,Host,Port} ->
+ case scan_abspath(C2) of
+ {error,Error} ->
+ {error,Error};
+ {[],[]} -> % Add implicit path
+ {Scheme,Creds,Host,Port,"/"};
+ {[],Path} ->
+ {Scheme,Creds,Host,Port,Path}
+ end;
+ {error,Error} ->
+ {error,Error}
+ end;
+ {error,Error} ->
+ {error,Error}
+ end.
+
+ftp_userinfo(C0) ->
+ User="",
+ Password="",
+ {C0,{User,Password}}.
+
+
+%%% ............................................................................
+%%% SIP (Source RFC 2396, RFC 2543)
+%%% sip_URL = "sip:" [ sip_userinfo "@" ] host [ ":" port ]
+%%% sip_url-parameters [ sip_headers ]
+%%% sip_userinfo = sip_user [ ":" sip_password ]
+%%% sip_user = *( unreserved | escaped | "&" | "=" | "+" | "$" | "," )
+%%% sip_password = *( unreserved | escaped | "&" | "=" | "+" | "$" | "," )
+%%% sip_url-parameters = *( ";" sip_url-parameter )
+%%% sip_url-parameter = sip_transport-param | sip_user-param |
+%%% sip_method-param | sip_ttl-param |
+%%% sip_maddr-param | sip_other-param
+%%% sip_transport-param = "transport=" ( "udp" | "tcp" )
+%%% sip_ttl-param = "ttl=" sip_ttl
+%%% sip_ttl = 1*3DIGIT ; 0 to 255
+%%% sip_maddr-param = "maddr=" host
+%%% sip_user-param = "user=" ( "phone" | "ip" )
+%%% sip_method-param = "method=" sip_Method
+%%% sip_tag-param = "tag=" sip_UUID
+%%% sip_UUID = 1*( hex | "-" )
+%%% sip_other-param = ( token | ( token "=" ( token | quoted-string )))
+%%% sip_Method = "INVITE" | "ACK" | "OPTIONS" | "BYE" |
+%%% "CANCEL" | "REGISTER"
+%%% sip_token = 1*< any CHAR except CTL's or separators>
+%%% sip_quoted-string = ( <"> *(qdtext | quoted-pair ) <"> )
+%%% sip_qdtext = <any TEXT-UTF8 except <">>
+%%% sip_quoted-pair = " \ " CHAR
+parse_sip(Cont,Scheme) ->
+ {Scheme,Cont}.
+
+
+
+
+%%% ............................................................................
+%%% SMS (Source draft-wilde-sms-uri-01, January 24 2002 and
+%%% draft-allocchio-gstn-01, November 2001)
+%%% The syntax definition for "gstn-phone" is taken from
+%%% [draft-allocchio-gstn-01], allowing global as well as local telephone
+%%% numbers.
+%%% Note: This BNF has been modified to better fit with RFC 2396
+%%% sms_URI = sms ":" 1*( sms-recipient ) [ sms-body ]
+%%% sms-recipient = gstn-phone sms-qualifier
+%%% [ "," sms-recipient ]
+%%% sms-qualifier = *( smsc-qualifier / pid-qualifier )
+%%% smsc-qualifier = ";smsc=" SMSC-sub-addr
+%%% pid-qualifier = ";pid=" PID-sub-addr
+%%% sms-body = ";body=" *urlc
+%%% gstn-phone = ( global-phone / local-phone )
+%%% global-phone = "+" 1*( DIGIT / written-sep )
+%%% local-phone = [ exit-code ] dial-number / exit-code [ dial-number ]
+%%% exit-code = phone-string
+%%% dial-number = phone-string
+%%% subaddr-string = phone-string
+%%% post-dial = phone-string
+%%% phone-string = 1*( DTMF / pause / tonewait / written-sep )
+%%% DTMF = ( DIGIT / "#" / "*" / "A" / "B" / "C" / "D" )
+%%% written-sep = ( "-" / "." )
+%%% pause = "p"
+%%% tonewait = "w"
+parse_sms(Cont,Scheme) ->
+ {Scheme,Cont}.
+
+
+%%% ============================================================================
+%%% Generic URI parsing. BNF rules from RFC 2396
+
+%%% hostport = host [ ":" port ]
+scan_hostport(C0,Scheme) ->
+ case scan_host(C0) of
+ {error,Error} ->
+ {error,Error};
+ {":"++C1,Host} ->
+ {C2,Port}=scan_port(C1,[]),
+ {C2,Host,list_to_integer(Port)};
+ {C1,Host} when Scheme==http ->
+ {C1,Host,?HTTP_DEFAULT_PORT};
+ {C1,Host} when Scheme==https ->
+ {C1,Host,?HTTPS_DEFAULT_PORT};
+ {C1,Host} when Scheme==ftp ->
+ {C1,Host,?FTP_DEFAULT_PORT}
+ end.
+
+
+%%% host = hostname | IPv4address
+%%% hostname = *( domainlabel "." ) toplabel [ "." ]
+%%% domainlabel = alphanum | alphanum *( alphanum | "-" ) alphanum
+%%% toplabel = alpha | alpha *( alphanum | "-" ) alphanum
+%%% IPv4address = 1*digit "." 1*digit "." 1*digit "." 1*digit
+
+-define(ALPHA, 1).
+-define(DIGIT, 2).
+
+scan_host(C0) ->
+ case scan_host2(C0,[],0,[],[]) of
+ {C1,IPv4address,[?DIGIT,?DIGIT,?DIGIT,?DIGIT]} ->
+ {C1,lists:reverse(lists:append(IPv4address))};
+ {C1,Hostname,[?ALPHA|HostF]} ->
+ {C1,lists:reverse(lists:append(Hostname))};
+ _ ->
+ {error,no_host}
+ end.
+
+scan_host2([H|C0],Acc,CurF,Host,HostF) when $0=<H,H=<$9 ->
+ scan_host2(C0,[H|Acc],CurF bor ?DIGIT,Host,HostF);
+scan_host2([H|C0],Acc,CurF,Host,HostF) when $a=<H,H=<$z; $A=<H,H=<$Z ->
+ scan_host2(C0,[H|Acc],CurF bor ?ALPHA,Host,HostF);
+scan_host2([$-|C0],Acc,CurF,Host,HostF) when CurF=/=0 ->
+ scan_host2(C0,[$-|Acc],CurF,Host,HostF);
+scan_host2([$.|C0],Acc,CurF,Host,HostF) when CurF=/=0 ->
+ scan_host2(C0,[],0,[".",Acc|Host],[CurF|HostF]);
+scan_host2(C0,Acc,CurF,Host,HostF) ->
+ {C0,[Acc|Host],[CurF|HostF]}.
+
+
+%%% port = *digit
+scan_port([H|C0],Acc) when $0=<H,H=<$9 ->
+ scan_port(C0,[H|Acc]);
+scan_port(C0,Acc) ->
+ {C0,lists:reverse(Acc)}.
+
+%%% abs_path = "/" path_segments
+scan_abspath([]) ->
+ {[],[]};
+scan_abspath("/"++C0) ->
+ scan_pathsegments(C0,["/"]);
+scan_abspath(_) ->
+ {error,no_abspath}.
+
+%%% path_segments = segment *( "/" segment )
+scan_pathsegments(C0,Acc) ->
+ case scan_segment(C0,[]) of
+ {"/"++C1,Segment} ->
+ scan_pathsegments(C1,["/",Segment|Acc]);
+ {C1,Segment} ->
+ {C1,lists:reverse(lists:append([Segment|Acc]))}
+ end.
+
+
+%%% segment = *pchar *( ";" param )
+%%% param = *pchar
+scan_segment(";"++C0,Acc) ->
+ {C1,ParamAcc}=scan_pchars(C0,";"++Acc),
+ scan_segment(C1,ParamAcc);
+scan_segment(C0,Acc) ->
+ case scan_pchars(C0,Acc) of
+ {";"++C1,Segment} ->
+ {C2,ParamAcc}=scan_pchars(C1,";"++Segment),
+ scan_segment(C2,ParamAcc);
+ {C1,Segment} ->
+ {C1,Segment}
+ end.
+
+%%% query = *uric
+%%% uric = reserved | unreserved | escaped
+%%% reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" |
+%%% "$" | ","
+%%% unreserved = alphanum | mark
+%%% mark = "-" | "_" | "." | "!" | "~" | "*" | "'" |
+%%% "(" | ")"
+%%% escaped = "%" hex hex
+scan_query([],Acc) ->
+ lists:reverse(Acc);
+scan_query([$%,H1,H2|C0],Acc) -> % escaped
+ scan_query(C0,[hex2dec(H1)*16+hex2dec(H2)|Acc]);
+scan_query([H|C0],Acc) when $a=<H,H=<$z;$A=<H,H=<$Z;$0=<H,H=<$9 -> % alphanum
+ scan_query(C0,[H|Acc]);
+scan_query([H|C0],Acc) when H==$;; H==$/; H==$?; H==$:; H==$@;
+ H==$&; H==$=; H==$+; H==$$; H==$, -> % reserved
+ scan_query(C0,[H|Acc]);
+scan_query([H|C0],Acc) when H==$-; H==$_; H==$.; H==$!; H==$~;
+ H==$*; H==$'; H==$(; H==$) -> % mark
+ scan_query(C0,[H|Acc]);
+scan_query([H|C0],Acc) ->
+ {error,no_query}.
+
+
+%%% pchar = unreserved | escaped |
+%%% ":" | "@" | "&" | "=" | "+" | "$" | ","
+scan_pchars([],Acc) ->
+ {[],Acc};
+scan_pchars([$%,H1,H2|C0],Acc) -> % escaped
+ scan_pchars(C0,[hex2dec(H1)*16+hex2dec(H2)|Acc]);
+scan_pchars([H|C0],Acc) when $a=<H,H=<$z;$A=<H,H=<$Z;$0=<H,H=<$9 -> % alphanum
+ scan_pchars(C0,[H|Acc]);
+scan_pchars([H|C0],Acc) when H==$-; H==$_; H==$.; H==$!; H==$~;
+ H==$*; H==$'; H==$(; H==$) -> % mark
+ scan_pchars(C0,[H|Acc]);
+scan_pchars([H|C0],Acc) when H==$:; H==$@; H==$&; H==$=; H==$+; H==$$; H==$, ->
+ scan_pchars(C0,[H|Acc]);
+scan_pchars(C0,Acc) ->
+ {C0,Acc}.
+
+hex2dec(X) when X>=$0,X=<$9 -> X-$0;
+hex2dec(X) when X>=$A,X=<$F -> X-$A+10;
+hex2dec(X) when X>=$a,X=<$f -> X-$a+10.