From ca4633fd683527097451ca1398c90c87bb5c14fc Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Sat, 2 Apr 2011 18:57:42 +0300 Subject: Rename suite data directories --- .../test/r9c_tests_SUITE_data/src/inets/Makefile | 178 --- .../test/r9c_tests_SUITE_data/src/inets/ftp.erl | 1582 -------------------- .../test/r9c_tests_SUITE_data/src/inets/http.erl | 260 ---- .../test/r9c_tests_SUITE_data/src/inets/http.hrl | 127 -- .../r9c_tests_SUITE_data/src/inets/http_lib.erl | 745 --------- .../src/inets/httpc_handler.erl | 724 --------- .../src/inets/httpc_manager.erl | 542 ------- .../test/r9c_tests_SUITE_data/src/inets/httpd.erl | 596 -------- .../test/r9c_tests_SUITE_data/src/inets/httpd.hrl | 77 - .../src/inets/httpd_acceptor.erl | 176 --- .../src/inets/httpd_acceptor_sup.erl | 118 -- .../r9c_tests_SUITE_data/src/inets/httpd_conf.erl | 688 --------- .../src/inets/httpd_example.erl | 134 -- .../src/inets/httpd_manager.erl | 1030 ------------- .../src/inets/httpd_misc_sup.erl | 116 -- .../r9c_tests_SUITE_data/src/inets/httpd_parse.erl | 348 ----- .../src/inets/httpd_request_handler.erl | 995 ------------ .../src/inets/httpd_response.erl | 437 ------ .../src/inets/httpd_socket.erl | 381 ----- .../r9c_tests_SUITE_data/src/inets/httpd_sup.erl | 203 --- .../r9c_tests_SUITE_data/src/inets/httpd_util.erl | 777 ---------- .../src/inets/httpd_verbosity.erl | 94 -- .../src/inets/httpd_verbosity.hrl | 65 - .../r9c_tests_SUITE_data/src/inets/inets.app.src | 56 - .../r9c_tests_SUITE_data/src/inets/inets.appup.src | 135 -- .../r9c_tests_SUITE_data/src/inets/inets.config | 2 - .../r9c_tests_SUITE_data/src/inets/inets_sup.erl | 158 -- .../r9c_tests_SUITE_data/src/inets/jnets_httpd.hrl | 138 -- .../r9c_tests_SUITE_data/src/inets/mod_actions.erl | 92 -- .../r9c_tests_SUITE_data/src/inets/mod_alias.erl | 175 --- .../r9c_tests_SUITE_data/src/inets/mod_auth.erl | 750 ---------- .../r9c_tests_SUITE_data/src/inets/mod_auth.hrl | 27 - .../src/inets/mod_auth_dets.erl | 222 --- .../src/inets/mod_auth_mnesia.erl | 276 ---- .../src/inets/mod_auth_plain.erl | 344 ----- .../src/inets/mod_auth_server.erl | 424 ------ .../r9c_tests_SUITE_data/src/inets/mod_browser.erl | 214 --- .../r9c_tests_SUITE_data/src/inets/mod_cgi.erl | 694 --------- .../r9c_tests_SUITE_data/src/inets/mod_dir.erl | 266 ---- .../src/inets/mod_disk_log.erl | 405 ----- .../r9c_tests_SUITE_data/src/inets/mod_esi.erl | 490 ------ .../r9c_tests_SUITE_data/src/inets/mod_get.erl | 179 --- .../r9c_tests_SUITE_data/src/inets/mod_head.erl | 89 -- .../src/inets/mod_htaccess.erl | 1150 -------------- .../r9c_tests_SUITE_data/src/inets/mod_include.erl | 726 --------- .../r9c_tests_SUITE_data/src/inets/mod_log.erl | 250 ---- .../r9c_tests_SUITE_data/src/inets/mod_range.erl | 397 ----- .../src/inets/mod_responsecontrol.erl | 337 ----- .../src/inets/mod_security.erl | 307 ---- .../src/inets/mod_security_server.erl | 728 --------- .../r9c_tests_SUITE_data/src/inets/mod_trace.erl | 69 - .../test/r9c_tests_SUITE_data/src/inets/uri.erl | 349 ----- 52 files changed, 19842 deletions(-) delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/ftp.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.hrl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http_lib.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_handler.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_manager.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.hrl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor_sup.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_conf.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_example.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_manager.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_misc_sup.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_parse.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_request_handler.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_response.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_socket.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_sup.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_util.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.hrl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.app.src delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.appup.src delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.config delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets_sup.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/jnets_httpd.hrl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_actions.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_alias.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.hrl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_dets.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_mnesia.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_plain.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_server.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_browser.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_cgi.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_dir.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_disk_log.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_get.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_head.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_htaccess.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_include.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_log.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_range.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_responsecontrol.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_trace.erl delete mode 100644 lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/uri.erl (limited to 'lib/dialyzer/test/r9c_tests_SUITE_data/src/inets') diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile b/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile deleted file mode 100644 index ab0d7c0a63..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/Makefile +++ /dev/null @@ -1,178 +0,0 @@ -# ``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 deleted file mode 100644 index be06ec654c..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/ftp.erl +++ /dev/null @@ -1,1582 +0,0 @@ -%% ``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 -%% , 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 , 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 (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 deleted file mode 100644 index 764e7fb092..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.erl +++ /dev/null @@ -1,260 +0,0 @@ -%% ``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("johan.blom@mobilearts.se"). - --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 deleted file mode 100644 index f10ca47a9a..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http.hrl +++ /dev/null @@ -1,127 +0,0 @@ -%% ``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 deleted file mode 100644 index eb8d7d66b1..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/http_lib.erl +++ /dev/null @@ -1,745 +0,0 @@ -%% ``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 -%%% 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("johan.blom@mobilearts.se"). - --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), - <>. - -%%% ---------------------------------------------------------------------------- -%%% 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 - <> when $0= - read_chunk(Scheme,Socket,Timeout,16*Int+(C-$0),MaxChunkSz); - <> when $a= - read_chunk(Scheme,Socket,Timeout,16*Int+10+(C-$a),MaxChunkSz); - <> when $A= - 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}; - <> when Int>0 -> - read_chunk_data(Scheme,Socket,Int+1,[],Timeout); - <> when Int==0 -> - read_data_lf(Scheme,Socket,Timeout), - {last_chunk,[]}; - <> 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 - <> -> - case read_more_data(Scheme,Socket,2,Timeout) of - <> -> - {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(<>,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 deleted file mode 100644 index 5076a12aaa..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_handler.erl +++ /dev/null @@ -1,724 +0,0 @@ -%% ``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 -%%% 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 = * -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 deleted file mode 100644 index 4659749270..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpc_manager.erl +++ /dev/null @@ -1,542 +0,0 @@ -%% ``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 -%% - --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 - 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 deleted file mode 100644 index 8cc1c133e9..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.erl +++ /dev/null @@ -1,596 +0,0 @@ -%% ``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 deleted file mode 100644 index ba21bdf638..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd.hrl +++ /dev/null @@ -1,77 +0,0 @@ -%% ``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 deleted file mode 100644 index 9b88f84865..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor.erl +++ /dev/null @@ -1,176 +0,0 @@ -%% ``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 deleted file mode 100644 index e408614f1c..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_acceptor_sup.erl +++ /dev/null @@ -1,118 +0,0 @@ -%% ``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 deleted file mode 100644 index 2c7a747d42..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_conf.erl +++ /dev/null @@ -1,688 +0,0 @@ -%% ``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 deleted file mode 100644 index 1819650963..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_example.erl +++ /dev/null @@ -1,134 +0,0 @@ -%% ``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]), - ["", - "", - "Test1", - "", - "", - "

Erlang Body

", - "

Stuff

", - "", - ""]. - - -get(Env,[]) -> - [header(), - top("GET Example"), - "
-Input: - -
-
" ++ "\n", - footer()]; - -get(Env,Input) -> - default(Env,Input). - -post(Env,[]) -> - [header(), - top("POST Example"), - "
-Input: - -
-
" ++ "\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"), - "Environment: ",io_lib:format("~p",[Env]),"
\n", - "Input: ",Input,"
\n", - "Parsed Input: ", - 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) -> - " - -" ++ Title ++ " - -\n". - -footer() -> - " -\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
"), - mod_esi:deliver(SessionID,"This new format is nice
"), - mod_esi:deliver(SessionID,"This new format is nice
"), - 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 deleted file mode 100644 index 78750c32c9..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_manager.erl +++ /dev/null @@ -1,1030 +0,0 @@ -%% ``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 deleted file mode 100644 index 5921c5db60..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_misc_sup.erl +++ /dev/null @@ -1,116 +0,0 @@ -%% ``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 deleted file mode 100644 index 3f8f0837f9..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_parse.erl +++ /dev/null @@ -1,348 +0,0 @@ -%% ``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 deleted file mode 100644 index 5008e6022e..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_request_handler.erl +++ /dev/null @@ -1,995 +0,0 @@ -%% ``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 deleted file mode 100644 index 4c7f8e0c8f..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_response.erl +++ /dev/null @@ -1,437 +0,0 @@ -%% ``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)-> - " - - "++ReasonPhrase++" - - -

"++ReasonPhrase++"

\n"++Message++"\n - \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 deleted file mode 100644 index 95dfc5e824..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_socket.erl +++ /dev/null @@ -1,381 +0,0 @@ -%% ``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 deleted file mode 100644 index fd557c30db..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_sup.erl +++ /dev/null @@ -1,203 +0,0 @@ -%% ``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 deleted file mode 100644 index 05064a8d38..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_util.erl +++ /dev/null @@ -1,777 +0,0 @@ -%% ``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 here."; -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. -

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 deleted file mode 100644 index c772a11dd1..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.erl +++ /dev/null @@ -1,94 +0,0 @@ -%% ``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 deleted file mode 100644 index caafd8ef18..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/httpd_verbosity.hrl +++ /dev/null @@ -1,65 +0,0 @@ -%% ``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 deleted file mode 100644 index 1bf5fcc56e..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.app.src +++ /dev/null @@ -1,56 +0,0 @@ -{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 deleted file mode 100644 index f612dc5b91..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.appup.src +++ /dev/null @@ -1,135 +0,0 @@ -{"%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 deleted file mode 100644 index adf0e3ecf1..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets.config +++ /dev/null @@ -1,2 +0,0 @@ -[{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 deleted file mode 100644 index 6bda87148c..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/inets_sup.erl +++ /dev/null @@ -1,158 +0,0 @@ -%% ``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 deleted file mode 100644 index 721a6b991d..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/jnets_httpd.hrl +++ /dev/null @@ -1,138 +0,0 @@ -%% ``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 deleted file mode 100644 index 93bdb9fb40..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_actions.erl +++ /dev/null @@ -1,92 +0,0 @@ -%% ``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 deleted file mode 100644 index e01c18b3d6..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_alias.erl +++ /dev/null @@ -1,175 +0,0 @@ -%% ``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", - "\n\n",ReasonPhrase, - "\n\n" - "\n

",ReasonPhrase, - "

\n", Message, - "\n\n\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 deleted file mode 100644 index dadb64e3c1..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.erl +++ /dev/null @@ -1,750 +0,0 @@ -%% ``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","\n\n", - ReasonPhrase,"\n", - "\n\n

",ReasonPhrase, - "

\n",Message,"\n\n\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: -%% -%% AuthDBType -%% AuthName -%% AuthUserFile -%% AuthGroupFile -%% AuthAccessPassword -%% require -%% allow -%% - -%% When a 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 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, 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 deleted file mode 100644 index ed3f437e60..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth.hrl +++ /dev/null @@ -1,27 +0,0 @@ -%% ``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 deleted file mode 100644 index 89d8574e83..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_dets.erl +++ /dev/null @@ -1,222 +0,0 @@ -%% ``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 deleted file mode 100644 index ec29022da0..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_mnesia.erl +++ /dev/null @@ -1,276 +0,0 @@ -%% ``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 deleted file mode 100644 index 2f92dcb446..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_plain.erl +++ /dev/null @@ -1,344 +0,0 @@ -%% ``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 deleted file mode 100644 index 6694ed7eac..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_auth_server.erl +++ /dev/null @@ -1,424 +0,0 @@ -%% ``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 deleted file mode 100644 index 62ffba0e5b..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_browser.erl +++ /dev/null @@ -1,214 +0,0 @@ -%% ``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 deleted file mode 100644 index d9070b8860..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_cgi.erl +++ /dev/null @@ -1,694 +0,0 @@ -%% ``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 deleted file mode 100644 index 449b088055..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_dir.erl +++ /dev/null @@ -1,266 +0,0 @@ -%% ``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= - "\n\nIndex of "++RequestURI++"\n\n\n

Index of "++ - RequestURI++"

\n
      Name                   Last modified         Size  Description
-
\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("\"[~s]\" Parent directory       ~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("\"[~s]\" ~-21.s..~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("\"[~s]\" ~s~*.*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("\"[~s]\" ~-21.s..~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("\"[~s]\" ~s~*.*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"),
-      "
\n
\n
\n"++binary_to_list(Body)++
-	"\n
\n\n\n"; - false -> - "\n\n\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 deleted file mode 100644 index c5d110ee4b..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_disk_log.erl +++ /dev/null @@ -1,405 +0,0 @@ -%% ``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 deleted file mode 100644 index d527f36788..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_esi.erl +++ /dev/null @@ -1,490 +0,0 @@ -%% ``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 deleted file mode 100644 index 02f708f85b..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_get.erl +++ /dev/null @@ -1,179 +0,0 @@ -%% ``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 deleted file mode 100644 index 542604e092..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_head.erl +++ /dev/null @@ -1,89 +0,0 @@ -%% ``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 deleted file mode 100644 index 069e4ad3a9..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_htaccess.erl +++ /dev/null @@ -1,1150 +0,0 @@ -%% ``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","\n\n", - ReasonPhrase,"\n", - "\n\n

",ReasonPhrase, - "

\n",Message,"\n\n\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 deleted file mode 100644 index c93e0a4f59..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_include.erl +++ /dev/null @@ -1,726 +0,0 @@ -%% ``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 deleted file mode 100644 index 29fa2cfd11..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_log.erl +++ /dev/null @@ -1,250 +0,0 @@ -%% ``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 deleted file mode 100644 index 0728bd2d91..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_range.erl +++ /dev/null @@ -1,397 +0,0 @@ -%% ``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 - 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= - case FileInfo#file_info.size of - FileSize when Start< FileSize -> - case FileInfo#file_info.size of - Size when End - {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 deleted file mode 100644 index c946098120..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_responsecontrol.erl +++ /dev/null @@ -1,337 +0,0 @@ -%% ``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= - ?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 deleted file mode 100644 index 14197979d1..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security.erl +++ /dev/null @@ -1,307 +0,0 @@ -%% ``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("",[{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 deleted file mode 100644 index 7df61df63e..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl +++ /dev/null @@ -1,728 +0,0 @@ -%% ``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 deleted file mode 100644 index 51fe6d283a..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_trace.erl +++ /dev/null @@ -1,69 +0,0 @@ -%% ``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 deleted file mode 100644 index e1acd62a31..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/uri.erl +++ /dev/null @@ -1,349 +0,0 @@ -%% ``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 -%% 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 -%% - --module(uri). - --author('johan.blom@mobilearts.se'). - --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= - parse_scheme2(URI,[H|Acc]); -parse_scheme(_,_) -> - {error,no_scheme}. - -parse_scheme2([H|URI],Acc) - when $a= - 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 = > -%%% 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= - scan_host2(C0,[H|Acc],CurF bor ?DIGIT,Host,HostF); -scan_host2([H|C0],Acc,CurF,Host,HostF) when $a= - 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= - 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= % 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= % 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. -- cgit v1.2.3