aboutsummaryrefslogtreecommitdiffstats
path: root/lib/inets/src/http_server
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/inets/src/http_server
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/inets/src/http_server')
-rw-r--r--lib/inets/src/http_server/Makefile139
-rw-r--r--lib/inets/src/http_server/httpd.erl600
-rw-r--r--lib/inets/src/http_server/httpd.hrl82
-rw-r--r--lib/inets/src/http_server/httpd_acceptor.erl211
-rw-r--r--lib/inets/src/http_server/httpd_acceptor_sup.erl97
-rw-r--r--lib/inets/src/http_server/httpd_cgi.erl124
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl1119
-rw-r--r--lib/inets/src/http_server/httpd_esi.erl108
-rw-r--r--lib/inets/src/http_server/httpd_example.erl145
-rw-r--r--lib/inets/src/http_server/httpd_file.erl45
-rw-r--r--lib/inets/src/http_server/httpd_instance_sup.erl169
-rw-r--r--lib/inets/src/http_server/httpd_internal.hrl31
-rw-r--r--lib/inets/src/http_server/httpd_log.erl121
-rw-r--r--lib/inets/src/http_server/httpd_manager.erl890
-rw-r--r--lib/inets/src/http_server/httpd_misc_sup.erl91
-rw-r--r--lib/inets/src/http_server/httpd_request.erl379
-rw-r--r--lib/inets/src/http_server/httpd_request_handler.erl611
-rw-r--r--lib/inets/src/http_server/httpd_response.erl407
-rw-r--r--lib/inets/src/http_server/httpd_script_env.erl144
-rw-r--r--lib/inets/src/http_server/httpd_socket.erl64
-rw-r--r--lib/inets/src/http_server/httpd_sup.erl264
-rw-r--r--lib/inets/src/http_server/httpd_util.erl780
-rw-r--r--lib/inets/src/http_server/mod_actions.erl117
-rw-r--r--lib/inets/src/http_server/mod_alias.erl210
-rw-r--r--lib/inets/src/http_server/mod_auth.erl797
-rw-r--r--lib/inets/src/http_server/mod_auth.hrl29
-rw-r--r--lib/inets/src/http_server/mod_auth_dets.erl254
-rw-r--r--lib/inets/src/http_server/mod_auth_mnesia.erl284
-rw-r--r--lib/inets/src/http_server/mod_auth_plain.erl325
-rw-r--r--lib/inets/src/http_server/mod_auth_server.erl400
-rw-r--r--lib/inets/src/http_server/mod_browser.erl249
-rw-r--r--lib/inets/src/http_server/mod_cgi.erl350
-rw-r--r--lib/inets/src/http_server/mod_dir.erl284
-rw-r--r--lib/inets/src/http_server/mod_disk_log.erl415
-rw-r--r--lib/inets/src/http_server/mod_esi.erl492
-rw-r--r--lib/inets/src/http_server/mod_get.erl126
-rw-r--r--lib/inets/src/http_server/mod_head.erl75
-rw-r--r--lib/inets/src/http_server/mod_htaccess.erl1078
-rw-r--r--lib/inets/src/http_server/mod_include.erl597
-rw-r--r--lib/inets/src/http_server/mod_log.erl256
-rw-r--r--lib/inets/src/http_server/mod_range.erl419
-rw-r--r--lib/inets/src/http_server/mod_responsecontrol.erl303
-rw-r--r--lib/inets/src/http_server/mod_security.erl325
-rw-r--r--lib/inets/src/http_server/mod_security_server.erl665
-rw-r--r--lib/inets/src/http_server/mod_trace.erl89
45 files changed, 14760 insertions, 0 deletions
diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile
new file mode 100644
index 0000000000..4bbd23df3f
--- /dev/null
+++ b/lib/inets/src/http_server/Makefile
@@ -0,0 +1,139 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2005-2009. All Rights Reserved.
+#
+# 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 online 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.
+#
+# %CopyrightEnd%
+#
+#
+include $(ERL_TOP)/make/target.mk
+EBIN = ../../ebin
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../../vsn.mk
+
+VSN = $(INETS_VSN)
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/inets-$(VSN)
+
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = \
+ httpd \
+ httpd_acceptor \
+ httpd_acceptor_sup \
+ httpd_cgi \
+ httpd_conf \
+ httpd_example \
+ httpd_esi \
+ httpd_file\
+ httpd_instance_sup \
+ httpd_log \
+ httpd_manager \
+ httpd_misc_sup \
+ httpd_request \
+ httpd_request_handler \
+ httpd_response \
+ httpd_script_env \
+ httpd_socket \
+ httpd_sup \
+ httpd_util \
+ 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_internal.hrl mod_auth.hrl
+
+ERL_FILES = $(MODULES:%=%.erl)
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+
+# ----------------------------------------------------
+# INETS FLAGS
+# ----------------------------------------------------
+INETS_FLAGS = -D'SERVER_SOFTWARE="inets/$(VSN)"'
+
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+INETS_ERL_FLAGS += -I ../http_lib -I ../inets_app -pa ../../ebin
+
+ERL_COMPILE_FLAGS += $(INETS_ERL_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:
+
+
+# ----------------------------------------------------
+# 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/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl
new file mode 100644
index 0000000000..554f162fc5
--- /dev/null
+++ b/lib/inets/src/http_server/httpd.erl
@@ -0,0 +1,600 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(httpd).
+
+-behaviour(inets_service).
+
+-include("httpd.hrl").
+
+-deprecated({start, 0, next_major_release}).
+-deprecated({start, 1, next_major_release}).
+-deprecated({start_link, 1, next_major_release}).
+-deprecated({start_child, 0, next_major_release}).
+-deprecated({start_child, 1, next_major_release}).
+-deprecated({stop, 0, next_major_release}).
+-deprecated({stop, 1, next_major_release}).
+-deprecated({stop, 2, next_major_release}).
+-deprecated({stop_child, 0, next_major_release}).
+-deprecated({stop_child, 1, next_major_release}).
+-deprecated({stop_child, 2, next_major_release}).
+-deprecated({restart, 0, next_major_release}).
+-deprecated({restart, 1, next_major_release}).
+-deprecated({restart, 2, next_major_release}).
+-deprecated({block, 0, next_major_release}).
+-deprecated({block, 1, next_major_release}).
+-deprecated({block, 2, next_major_release}).
+-deprecated({block, 3, next_major_release}).
+-deprecated({block, 4, next_major_release}).
+-deprecated({unblock, 0, next_major_release}).
+-deprecated({unblock, 1, next_major_release}).
+-deprecated({unblock, 2, next_major_release}).
+
+%% Behavior callbacks
+-export([start_standalone/1, start_service/1, stop_service/1, services/0,
+ service_info/1]).
+
+%% API
+-export([parse_query/1, reload_config/2, info/1, info/2, info/3]).
+
+%% Deprecated
+-export([start/0, start/1,
+ start_link/0, start_link/1,
+ start_child/0,start_child/1,
+ stop/0,stop/1,stop/2,
+ stop_child/0,stop_child/1,stop_child/2,
+ restart/0,restart/1,restart/2]).
+
+%% Management stuff should be internal functions
+%% Will be from r13
+-export([block/0,block/1,block/2,block/3,block/4,
+ unblock/0,unblock/1,unblock/2]).
+
+%% Internal Debugging and status info stuff...
+%% Keep for now should probably be moved to test catalog
+-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]).
+
+%%%========================================================================
+%%% API
+%%%========================================================================
+
+parse_query(String) ->
+ {ok, SplitString} = inets_regexp:split(String,"[&;]"),
+ foreach(SplitString).
+
+reload_config(Config = [Value| _], Mode) when is_tuple(Value) ->
+ do_reload_config(Config, Mode);
+reload_config(ConfigFile, Mode) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ do_reload_config(ConfigList, Mode);
+ Error ->
+ Error
+ end.
+
+info(Pid) when is_pid(Pid) ->
+ info(Pid, []).
+
+info(Pid, Properties) when is_pid(Pid) andalso is_list(Properties) ->
+ {ok, ServiceInfo} = service_info(Pid),
+ Address = proplists:get_value(bind_address, ServiceInfo),
+ Port = proplists:get_value(port, ServiceInfo),
+ case Properties of
+ [] ->
+ info(Address, Port);
+ _ ->
+ info(Address, Port, Properties)
+ end;
+info(Address, Port) when is_integer(Port) ->
+ httpd_conf:get_config(Address, Port).
+
+info(Address, Port, Properties) when is_integer(Port) andalso
+ is_list(Properties) ->
+ httpd_conf:get_config(Address, Port, Properties).
+
+%%%========================================================================
+%%% Behavior callbacks
+%%%========================================================================
+
+start_standalone(Config) ->
+ httpd_sup:start_link([{httpd, Config}], stand_alone).
+
+start_service(Conf) ->
+ httpd_sup:start_child(Conf).
+
+stop_service({Address, Port}) ->
+ httpd_sup:stop_child(Address, Port);
+
+stop_service(Pid) when is_pid(Pid) ->
+ case service_info(Pid) of
+ {ok, Info} ->
+ Address = proplists:get_value(bind_address, Info),
+ Port = proplists:get_value(port, Info),
+ stop_service({Address, Port});
+ Error ->
+ Error
+ end.
+
+services() ->
+ [{httpd, ChildPid} || {_, ChildPid, _, _} <-
+ supervisor:which_children(httpd_sup)].
+
+service_info(Pid) ->
+ try
+ [{ChildName, ChildPid} ||
+ {ChildName, ChildPid, _, _} <-
+ supervisor:which_children(httpd_sup)] of
+ Children ->
+ child_name2info(child_name(Pid, Children))
+ catch
+ exit:{noproc, _} ->
+ {error, service_not_available}
+ end.
+%%%--------------------------------------------------------------
+%%% Internal functions
+%%%--------------------------------------------------------------------
+
+child_name(_, []) ->
+ undefined;
+child_name(Pid, [{Name, Pid} | _]) ->
+ Name;
+child_name(Pid, [_ | Children]) ->
+ child_name(Pid, Children).
+
+child_name2info(undefined) ->
+ {error, no_such_service};
+child_name2info({httpd_instance_sup, any, Port}) ->
+ {ok, Host} = inet:gethostname(),
+ Info = info(any, Port, [server_name]),
+ {ok, [{bind_address, any}, {host, Host}, {port, Port} | Info]};
+child_name2info({httpd_instance_sup, Address, Port}) ->
+ Info = info(Address, Port, [server_name]),
+ case inet:gethostbyaddr(Address) of
+ {ok, {_, Host, _, _,_, _}} ->
+ {ok, [{bind_address, Address},
+ {host, Host}, {port, Port} | Info]};
+ _ ->
+ {ok, [{bind_address, Address}, {port, Port} | Info]}
+ end.
+
+reload(Config, Address, Port) ->
+ Name = make_name(Address,Port),
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ httpd_manager:reload(Pid, Config);
+ _ ->
+ {error,not_started}
+ end.
+
+reload(Addr, Port) when is_integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ httpd_manager:reload(Pid, undefined);
+ _ ->
+ {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 is_integer(Port) ->
+ block(undefined,Port,disturbing);
+
+block(ConfigFile) when is_list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ block(Addr,Port,disturbing);
+ Error ->
+ Error
+ end.
+
+block(Addr,Port) when is_integer(Port) ->
+ block(Addr,Port,disturbing);
+
+block(Port,Mode) when is_integer(Port) andalso is_atom(Mode) ->
+ block(undefined,Port,Mode);
+
+block(ConfigFile,Mode) when is_list(ConfigFile) andalso is_atom(Mode) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ block(Addr,Port,Mode);
+ Error ->
+ Error
+ end.
+
+
+block(Addr,Port,disturbing) when is_integer(Port) ->
+ do_block(Addr,Port,disturbing);
+block(Addr,Port,non_disturbing) when is_integer(Port) ->
+ do_block(Addr,Port,non_disturbing);
+
+block(ConfigFile,Mode,Timeout) when is_list(ConfigFile) andalso
+ is_atom(Mode) andalso
+ is_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 is_integer(Port) andalso is_integer(Timeout) ->
+ do_block(Addr,Port,non_disturbing,Timeout);
+block(Addr,Port,disturbing,Timeout) when is_integer(Port) andalso
+ is_integer(Timeout) ->
+ do_block(Addr,Port,disturbing,Timeout).
+
+do_block(Addr,Port,Mode) when is_integer(Port) andalso is_atom(Mode) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ httpd_manager:block(Pid,Mode);
+ _ ->
+ {error,not_started}
+ end.
+
+
+do_block(Addr,Port,Mode,Timeout)
+ when is_integer(Port) andalso is_atom(Mode) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when is_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 is_integer(Port) -> unblock(undefined,Port);
+
+unblock(ConfigFile) when is_list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ unblock(Addr,Port);
+ Error ->
+ Error
+ end.
+
+unblock(Addr, Port) when is_integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ httpd_manager:unblock(Pid);
+ _ ->
+ {error,not_started}
+ end.
+
+foreach([]) ->
+ [];
+foreach([KeyValue|Rest]) ->
+ {ok, Plus2Space, _} = inets_regexp:gsub(KeyValue,"[\+]"," "),
+ case inets_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(ConfigFile) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ case httpd_conf:validate_properties(ConfigList) of
+ {ok, Config} ->
+ Address = proplists:get_value(bind_address, Config, any),
+ Port = proplists:get_value(port, Config, 80),
+ {ok, Address, Port};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+
+make_name(Addr, Port) ->
+ httpd_util:make_name("httpd", Addr, Port).
+
+
+%%%--------------------------------------------------------------
+%%% Internal debug functions - Do we want these functions here!?
+%%%--------------------------------------------------------------------
+
+%%% =========================================================
+%%% 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 is_integer(Port) -> get_admin_state(undefined,Port);
+
+get_admin_state(ConfigFile) when is_list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ unblock(Addr,Port);
+ Error ->
+ Error
+ end.
+
+get_admin_state(Addr,Port) when is_integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when is_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 is_integer(Port) -> get_usage_state(undefined,Port);
+
+get_usage_state(ConfigFile) when is_list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ unblock(Addr,Port);
+ Error ->
+ Error
+ end.
+
+get_usage_state(Addr,Port) when is_integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when is_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 is_list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok,Addr,Port} ->
+ get_status(Addr,Port);
+ Error ->
+ Error
+ end;
+
+get_status(Port) when is_integer(Port) ->
+ get_status(undefined,Port,5000).
+
+get_status(Port,Timeout) when is_integer(Port) andalso is_integer(Timeout) ->
+ get_status(undefined,Port,Timeout);
+
+get_status(Addr,Port) ->
+ get_status(Addr,Port,5000).
+
+get_status(Addr,Port,Timeout) when is_integer(Port) ->
+ Name = make_name(Addr,Port),
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ httpd_manager:get_status(Pid,Timeout);
+ _ ->
+ not_started
+ end.
+
+do_reload_config(ConfigList, Mode) ->
+ case httpd_conf:validate_properties(ConfigList) of
+ {ok, Config} ->
+ Address = proplists:get_value(bind_address, Config, any),
+ Port = proplists:get_value(port, Config, 80),
+ block(Address, Port, Mode),
+ reload(Config, Address, Port),
+ unblock(Address, Port);
+ Error ->
+ Error
+ end.
+
+
+%%%--------------------------------------------------------------
+%%% Deprecated
+%%%--------------------------------------------------------------
+start() ->
+ start("/var/tmp/server_root/conf/8888.conf").
+
+start(ConfigFile) ->
+ {ok, Pid} = inets:start(httpd, ConfigFile, stand_alone),
+ unlink(Pid),
+ {ok, Pid}.
+
+start_link() ->
+ start("/var/tmp/server_root/conf/8888.conf").
+
+start_link(ConfigFile) when is_list(ConfigFile) ->
+ inets:start(httpd, ConfigFile, stand_alone).
+
+stop() ->
+ stop(8888).
+
+stop(Port) when is_integer(Port) ->
+ stop(undefined, Port);
+stop(Pid) when is_pid(Pid) ->
+ old_stop(Pid);
+stop(ConfigFile) when is_list(ConfigFile) ->
+ old_stop(ConfigFile).
+
+stop(Addr, Port) when is_integer(Port) ->
+ old_stop(Addr, Port).
+
+start_child() ->
+ start_child("/var/tmp/server_root/conf/8888.conf").
+
+start_child(ConfigFile) ->
+ httpd_sup:start_child(ConfigFile).
+
+stop_child() ->
+ stop_child(8888).
+
+stop_child(Port) ->
+ stop_child(undefined, Port).
+
+stop_child(Addr, Port) when is_integer(Port) ->
+ httpd_sup:stop_child(Addr, Port).
+
+restart() -> reload(undefined, 8888).
+
+restart(Port) when is_integer(Port) ->
+ reload(undefined, Port).
+restart(Addr, Port) ->
+ reload(Addr, Port).
+
+old_stop(Pid) when is_pid(Pid) ->
+ do_stop(Pid);
+old_stop(ConfigFile) when is_list(ConfigFile) ->
+ case get_addr_and_port(ConfigFile) of
+ {ok, Addr, Port} ->
+ old_stop(Addr, Port);
+
+ Error ->
+ Error
+ end;
+old_stop(_StartArgs) ->
+ ok.
+
+old_stop(Addr, Port) when is_integer(Port) ->
+ Name = old_make_name(Addr, Port),
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ do_stop(Pid),
+ ok;
+ _ ->
+ not_started
+ end.
+
+do_stop(Pid) ->
+ exit(Pid, shutdown).
+
+old_make_name(Addr,Port) ->
+ httpd_util:make_name("httpd_instance_sup",Addr,Port).
diff --git a/lib/inets/src/http_server/httpd.hrl b/lib/inets/src/http_server/httpd.hrl
new file mode 100644
index 0000000000..0db8a029bb
--- /dev/null
+++ b/lib/inets/src/http_server/httpd.hrl
@@ -0,0 +1,82 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-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(DEFAULT_MODS, [mod_alias, mod_auth, mod_esi, mod_actions, mod_cgi,
+ mod_dir, mod_get, mod_head, mod_log, mod_disk_log]).
+-define(SOCKET_CHUNK_SIZE,8192).
+-define(SOCKET_MAX_POLL,25).
+-define(FILE_CHUNK_SIZE,64*1024).
+-define(GATEWAY_INTERFACE,"CGI/1.1").
+-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/inets/src/http_server/httpd_acceptor.erl b/lib/inets/src/http_server/httpd_acceptor.erl
new file mode 100644
index 0000000000..568fd3c610
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_acceptor.erl
@@ -0,0 +1,211 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_acceptor).
+
+-include("httpd.hrl").
+-include("httpd_internal.hrl").
+
+%% Internal application API
+-export([start_link/5, start_link/6]).
+
+%% Other exports (for spawn's etc.)
+-export([acceptor_init/6, acceptor_init/7, acceptor_loop/5]).
+
+%%
+%% External API
+%%
+
+%% start_link
+
+start_link(Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout) ->
+ ?hdrd("start link",
+ [{manager, Manager},
+ {socket_type, SocketType},
+ {address, Addr},
+ {port, Port},
+ {timeout, AcceptTimeout}]),
+ Args = [self(), Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout],
+ proc_lib:start_link(?MODULE, acceptor_init, Args).
+
+start_link(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) ->
+ ?hdrd("start link",
+ [{manager, Manager},
+ {socket_type, SocketType},
+ {listen_socket, ListenSocket},
+ {timeout, AcceptTimeout}]),
+ Args = [self(), Manager, SocketType, ListenSocket,
+ ConfigDb, AcceptTimeout],
+ proc_lib:start_link(?MODULE, acceptor_init, Args).
+
+acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket},
+ ConfigDb, AcceptTimeout) ->
+ ?hdrd("acceptor init",
+ [{parent, Parent},
+ {manager, Manager},
+ {socket_type, SocketType},
+ {listen_owner, ListenOwner},
+ {listen_socket, ListenSocket},
+ {timeout, AcceptTimeout}]),
+ link(ListenOwner),
+ proc_lib:init_ack(Parent, {ok, self()}),
+ acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout).
+
+acceptor_init(Parent, Manager, SocketType, Addr, Port,
+ ConfigDb, AcceptTimeout) ->
+ ?hdrd("acceptor init",
+ [{parent, Parent},
+ {manager, Manager},
+ {socket_type, SocketType},
+ {address, Addr},
+ {port, Port},
+ {timeout, AcceptTimeout}]),
+ case (catch do_init(SocketType, Addr, Port)) of
+ {ok, ListenSocket} ->
+ proc_lib:init_ack(Parent, {ok, self()}),
+ acceptor_loop(Manager, SocketType,
+ ListenSocket, ConfigDb, AcceptTimeout);
+ Error ->
+ proc_lib:init_ack(Parent, Error),
+ error
+ end.
+
+do_init(SocketType, Addr, Port) ->
+ ?hdrt("do init", []),
+ do_socket_start(SocketType),
+ ListenSocket = do_socket_listen(SocketType, Addr, Port),
+ {ok, ListenSocket}.
+
+
+do_socket_start(SocketType) ->
+ ?hdrt("do socket start", []),
+ case http_transport:start(SocketType) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ ?hdrv("failed starting transport", [{reason, Reason}]),
+ throw({error, {socket_start_failed, Reason}})
+ end.
+
+
+do_socket_listen(SocketType, Addr, Port) ->
+ ?hdrt("do socket listen", []),
+ case http_transport:listen(SocketType, Addr, Port) of
+ {ok, ListenSocket} ->
+ ListenSocket;
+ {error, Reason} ->
+ ?hdrv("listen failed", [{reason, Reason},
+ {socket_type, SocketType},
+ {addr, Addr},
+ {port, Port}]),
+ throw({error, {listen, Reason}})
+ end.
+
+
+%% acceptor
+
+acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) ->
+ ?hdrd("awaiting accept",
+ [{manager, Manager},
+ {socket_type, SocketType},
+ {listen_socket, ListenSocket},
+ {timeout, AcceptTimeout}]),
+ case (catch http_transport:accept(SocketType, ListenSocket, 50000)) of
+ {ok, Socket} ->
+ ?hdrv("accepted", [{socket, Socket}]),
+ handle_connection(Manager, ConfigDb, AcceptTimeout,
+ SocketType, Socket),
+ ?MODULE:acceptor_loop(Manager, SocketType,
+ ListenSocket, ConfigDb,AcceptTimeout);
+ {error, Reason} ->
+ ?hdri("accept failed", [{reason, Reason}]),
+ handle_error(Reason, ConfigDb),
+ ?MODULE:acceptor_loop(Manager, SocketType, ListenSocket,
+ ConfigDb, AcceptTimeout);
+ {'EXIT', Reason} ->
+ ?hdri("accept exited", [{reason, Reason}]),
+ handle_error({'EXIT', Reason}, ConfigDb),
+ ?MODULE:acceptor_loop(Manager, SocketType, ListenSocket,
+ ConfigDb, AcceptTimeout)
+ end.
+
+
+handle_connection(Manager, ConfigDb, AcceptTimeout, SocketType, Socket) ->
+ {ok, Pid} = httpd_request_handler:start(Manager, ConfigDb, AcceptTimeout),
+ http_transport:controlling_process(SocketType, Socket, Pid),
+ httpd_request_handler:socket_ownership_transfered(Pid, SocketType, Socket).
+
+handle_error(timeout, _) ->
+ ok;
+
+handle_error({enfile, _}, _) ->
+ %% Out of sockets...
+ sleep(200);
+
+handle_error(emfile, _) ->
+ %% Too many open files -> Out of sockets...
+ sleep(200);
+
+handle_error(closed, _) ->
+ error_logger:info_report("The httpd accept socket was closed by "
+ "a third party. "
+ "This will not have an impact on inets "
+ "that will open a new accept socket and "
+ "go on as nothing happened. It does however "
+ "indicate that some other software is behaving "
+ "badly."),
+ exit(normal);
+
+%% This will only happen when the client is terminated abnormaly
+%% and is not a problem for the server, so we want
+%% to terminate normal so that we can restart without any
+%% error messages.
+handle_error(econnreset,_) ->
+ exit(normal);
+
+handle_error(econnaborted, _) ->
+ 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) ->
+ String = lists:flatten(io_lib:format("Accept exit: ~p", [Reason])),
+ accept_failed(ConfigDb, String);
+
+handle_error(Reason, ConfigDb) ->
+ String = lists:flatten(io_lib:format("Accept error: ~p", [Reason])),
+ accept_failed(ConfigDb, String).
+
+-spec accept_failed(_, string()) -> no_return().
+
+accept_failed(ConfigDb, String) ->
+ error_logger:error_report(String),
+ InitData = #init_data{peername = {0, "unknown"}},
+ Info = #mod{config_db = ConfigDb, init_data = InitData},
+ mod_log:error_log(Info, String),
+ mod_disk_log:error_log(Info, String),
+ exit({accept_failed, String}).
+
+sleep(T) -> receive after T -> ok end.
+
+
diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl
new file mode 100644
index 0000000000..8b1e4b6c4f
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl
@@ -0,0 +1,97 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The supervisor for acceptor processes in the http server,
+%% hangs under the httpd_instance_sup_<Addr>_<Port> supervisor.
+%%----------------------------------------------------------------------
+
+-module(httpd_acceptor_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/2, start_acceptor/5, start_acceptor/6, stop_acceptor/2]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+start_link(Addr, Port) ->
+ SupName = make_name(Addr, Port),
+ supervisor:start_link({local, SupName}, ?MODULE, []).
+
+%%----------------------------------------------------------------------
+%% Function: [start|stop]_acceptor/5
+%% Description: Starts/stops an [auth | security] worker (child) process
+%%----------------------------------------------------------------------
+start_acceptor(SocketType, Addr, Port, ConfigDb, AcceptTimeout) ->
+ start_worker(httpd_acceptor, SocketType, Addr, Port,
+ ConfigDb, AcceptTimeout, self(), []).
+start_acceptor(SocketType, Addr, Port, ConfigDb, AcceptTimeout, ListenSocket) ->
+ start_worker(httpd_acceptor, SocketType, Addr, Port,
+ ConfigDb, AcceptTimeout, ListenSocket, self(), []).
+
+
+stop_acceptor(Addr, Port) ->
+ stop_worker(httpd_acceptor, Addr, Port).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+init(_) ->
+ Flags = {one_for_one, 500, 100},
+ Workers = [],
+ {ok, {Flags, Workers}}.
+
+%%%=========================================================================
+%%% Internal functions
+%%%=========================================================================
+
+make_name(Addr,Port) ->
+ httpd_util:make_name("httpd_acc_sup", Addr, Port).
+
+start_worker(M, SocketType, Addr, Port, ConfigDB, AcceptTimeout, Manager, Modules) ->
+ SupName = make_name(Addr, Port),
+ Args = [Manager, SocketType, Addr, Port, ConfigDB, AcceptTimeout],
+ Spec = {{M, Addr, Port},
+ {M, start_link, Args},
+ permanent, timer:seconds(1), worker, [M] ++ Modules},
+ supervisor:start_child(SupName, Spec).
+
+start_worker(M, SocketType, Addr, Port, ConfigDB, AcceptTimeout, ListenSocket,
+ Manager, Modules) ->
+ SupName = make_name(Addr, Port),
+ Args = [Manager, SocketType, ListenSocket, ConfigDB, AcceptTimeout],
+ Spec = {{M, Addr, Port},
+ {M, start_link, Args},
+ permanent, timer:seconds(1), worker, [M] ++ Modules},
+ supervisor:start_child(SupName, Spec).
+
+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.
diff --git a/lib/inets/src/http_server/httpd_cgi.erl b/lib/inets/src/http_server/httpd_cgi.erl
new file mode 100644
index 0000000000..0532d7d100
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_cgi.erl
@@ -0,0 +1,124 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_cgi).
+
+-export([parse_headers/1, handle_headers/1]).
+
+-include("inets_internal.hrl").
+
+%%%=========================================================================
+%%% Internal application API
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% parse_headers([Bin, Data, Header, Headers]) -> {RevHeaders, Body} |
+%% {Module, Function, Args}
+%% Bin = Data = binary()
+%% Header = string() - Accumulator should be [] in first call
+%% Headers = [Header] - Accumulator should be [] in first call
+%% Body = string()
+%% RevHeaders = string() - Note CGI-headers not HTTP-headers
+%%
+%% Description: Parses "<<Bin/binary, Data/binary>>" returned from the
+%% CGI-script until it findes the end of the CGI-headers (at least one
+%% CGI-HeaderField must be supplied) then it returns the CGI-headers
+%% and maybe some body data. If {Module, Function, Args} is
+%% returned it means that more data needs to be collected from the
+%% cgi-script as the end of the headers was not yet found. When more
+%% data has been collected call Module:Function([NewData | Args]).
+%%
+%% NOTE: The headers are backwards and should
+%% be so, devide_and_reverse_headers will reverse them back after
+%% taking advantage of the fact that they where backwards.
+%%--------------------------------------------------------------------------
+parse_headers([Data, Bin, Header, Headers]) ->
+ parse_headers(<<Bin/binary, Data/binary>>, Header, Headers).
+
+%%--------------------------------------------------------------------------
+%% handle_headers(CGIHeaders) -> {ok, HTTPHeaders, StatusCode} |
+%% {proceed, AbsPath}
+%% CGIHeaders = [string()]
+%% HTTPHeaders = [{HeaderField, HeaderValue}]
+%% HeaderField = string()
+%% HeaderValue = string()
+%% StatusCode = integer()
+%%
+%% Description: Interprets CGI headers and creates HTTP headers and a
+%% appropriate HTTP status code. Note if a CGI location header is present
+%% the return value will be {proceed, AbsPath}
+%%--------------------------------------------------------------------------
+handle_headers(CGIHeaders) ->
+ handle_headers(CGIHeaders, [], {200, "ok"}).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+parse_headers(<<>>, Header, Headers) ->
+ {?MODULE, parse_headers, [<<>>, Header, Headers]};
+parse_headers(<<?CR,?LF>>, Header, Headers) ->
+ {?MODULE, parse_headers, [<<?CR,?LF>>, Header, Headers]};
+parse_headers(<<?LF>>, Header, Headers) ->
+ {?MODULE, parse_headers, [<<?LF>>, Header, Headers]};
+parse_headers(<<?CR, ?LF, ?CR, ?LF, Rest/binary>>, Header, Headers) ->
+ {ok, {[lists:reverse([?LF, ?CR | Header]) | Headers], Rest}};
+parse_headers(<<?LF, ?LF, Rest/binary>>, Header, Headers) ->
+ {ok, {[lists:reverse([?LF | Header]) | Headers], Rest}};
+parse_headers(<<?CR, ?LF, Rest/binary>>, Header, Headers) ->
+ parse_headers(Rest, [], [lists:reverse([?LF, ?CR | Header]) | Headers]);
+parse_headers(<<?LF, Rest/binary>>, Header, Headers) ->
+ parse_headers(Rest, [], [lists:reverse([?LF | Header]) | Headers]);
+parse_headers(<<Octet, Rest/binary>>, Header, Headers) ->
+ parse_headers(Rest, [Octet | Header], Headers).
+
+handle_headers([], HTTPHeaders, Status) ->
+ {ok, HTTPHeaders, Status};
+
+handle_headers([CGIHeader | CGIHeaders], HTTPHeaders, Status) ->
+
+ {FieldName, FieldValue} = httpd_response:split_header(CGIHeader, []),
+
+ case FieldName of
+ "content-type" ->
+ handle_headers(CGIHeaders,
+ [{FieldName, FieldValue} | HTTPHeaders],
+ Status);
+ "location" ->
+ case http_request:is_absolut_uri(FieldValue) of
+ true ->
+ handle_headers(CGIHeaders,
+ [{FieldName, FieldValue} |
+ HTTPHeaders], {302, "Redirect"});
+ false ->
+ {proceed, FieldValue}
+ end;
+ "status" ->
+ CodePhrase =
+ case httpd_util:split(FieldValue," ",2) of
+ {ok,[Code, Phrase]} ->
+ {list_to_integer(Code), Phrase};
+ _ ->
+ {200, "OK"}
+ end,
+ handle_headers(CGIHeaders, HTTPHeaders, CodePhrase);
+ _ -> %% Extension headers
+ handle_headers(CGIHeaders,
+ [{FieldName, FieldValue} | HTTPHeaders], Status)
+ end.
+
diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl
new file mode 100644
index 0000000000..9c93e2c5fe
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_conf.erl
@@ -0,0 +1,1119 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_conf).
+
+%% EWSAPI
+-export([is_directory/1, is_file/1, make_integer/1, clean/1,
+ custom_clean/3, check_enum/2]).
+
+%% Application internal API
+-export([load/1, load/2, load_mime_types/1, store/1, store/2,
+ remove/1, remove_all/1, config/1, get_config/2, get_config/3,
+ lookup/2, lookup/3, lookup/4,
+ validate_properties/1]).
+
+-define(VMODULE,"CONF").
+-include("httpd.hrl").
+-include("httpd_internal.hrl").
+
+
+%%%=========================================================================
+%%% EWSAPI
+%%%=========================================================================
+%%-------------------------------------------------------------------------
+%% is_directory(FilePath) -> Result
+%% FilePath = string()
+%% Result = {ok,Directory} | {error,Reason}
+%% Directory = string()
+%% Reason = string() | enoent | eaccess | enotdir | FileInfo
+%% FileInfo = File info record
+%%
+%% Description: Checks if FilePath is a directory in which case it is
+%% returned.
+%%-------------------------------------------------------------------------
+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(FilePath) -> Result
+%% FilePath = string()
+%% Result = {ok,File} | {error,Reason}
+%% File = string()
+%% Reason = string() | enoent | eaccess | enotdir | FileInfo
+%% FileInfo = File info record
+%%
+%% Description: Checks if FilePath is a regular file in which case it
+%% is returned.
+%%-------------------------------------------------------------------------
+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(String) -> Result
+%% String = string()
+%% Result = {ok,integer()} | {error,nomatch}
+%%
+%% Description: make_integer/1 returns an integer representation of String.
+%%-------------------------------------------------------------------------
+make_integer(String) ->
+ case inets_regexp:match(clean(String),"[0-9]+") of
+ {match, _, _} ->
+ {ok, list_to_integer(clean(String))};
+ nomatch ->
+ {error, nomatch}
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% clean(String) -> Stripped
+%% String = Stripped = string()
+%%
+%% Description:clean/1 removes leading and/or trailing white spaces
+%% from String.
+%%-------------------------------------------------------------------------
+clean(String) ->
+ {ok,CleanedString,_} =
+ inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""),
+ CleanedString.
+
+
+%%-------------------------------------------------------------------------
+%% custom_clean(String,Before,After) -> Stripped
+%% Before = After = regexp()
+%% String = Stripped = string()
+%%
+%% Description: custom_clean/3 removes leading and/or trailing white
+%% spaces and custom characters from String.
+%%-------------------------------------------------------------------------
+custom_clean(String,MoreBefore,MoreAfter) ->
+ {ok,CleanedString,_} = inets_regexp:gsub(String,"^[ \t\n\r\f"++MoreBefore++
+ "]*|[ \t\n\r\f"++MoreAfter++"]*\$",""),
+ CleanedString.
+
+
+%%-------------------------------------------------------------------------
+%% check_enum(EnumString,ValidEnumStrings) -> Result
+%% EnumString = string()
+%% ValidEnumStrings = [string()]
+%% Result = {ok,atom()} | {error,not_valid}
+%%
+%% Description: check_enum/2 checks if EnumString is a valid
+%% enumeration of ValidEnumStrings in which case it is returned as an
+%% atom.
+%%-------------------------------------------------------------------------
+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).
+
+
+%%%=========================================================================
+%%% Application internal API
+%%%=========================================================================
+%% 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).
+
+%% Phase 1: Load
+load(ConfigFile) ->
+ ?hdrv("load config", [{config_file, ConfigFile}]),
+ case read_config_file(ConfigFile) of
+ {ok, Config} ->
+ ?hdrt("config read", []),
+ case bootstrap(Config) of
+ {error, Reason} ->
+ ?hdri("bootstrap failed", [{reason, Reason}]),
+ {error, Reason};
+ {ok, Modules} ->
+ ?hdrd("config bootstrapped", [{modules, Modules}]),
+ load_config(Config, lists:append(Modules, [?MODULE]))
+ end;
+ {error, Reason} ->
+ ?hdri("failed reading config file", [{reason, Reason}]),
+ {error, ?NICE("Error while reading config file: "++Reason)}
+ end.
+
+load(eof, []) ->
+ eof;
+
+load("MaxHeaderSize " ++ 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("MaxURISize " ++ MaxHeaderSize, []) ->
+ case make_integer(MaxHeaderSize) of
+ {ok, Integer} ->
+ {ok, [], {max_uri_size, Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(MaxHeaderSize)++
+ " is an invalid number of MaxHeaderSize")}
+ end;
+
+load("MaxBodySize " ++ 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("ServerName " ++ ServerName, []) ->
+ {ok,[],{server_name,clean(ServerName)}};
+
+load("SocketType " ++ SocketType, []) ->
+ case check_enum(clean(SocketType),["ssl","ip_comm"]) of
+ {ok, ValidSocketType} ->
+ {ok, [], {socket_type,ValidSocketType}};
+ {error,_} ->
+ {error, ?NICE(clean(SocketType) ++ " is an invalid SocketType")}
+ end;
+
+load("Port " ++ Port, []) ->
+ case make_integer(Port) of
+ {ok, Integer} ->
+ {ok, [], {port,Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(Port)++" is an invalid Port")}
+ end;
+
+load("BindAddress " ++ Address0, []) ->
+ %% If an ipv6 address is provided in URL-syntax strip the
+ %% url specific part e.i. "[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]"
+ %% -> "FEDC:BA98:7654:3210:FEDC:BA98:7654:3210"
+
+ try
+ begin
+ ?hdrv("load BindAddress", [{address0, Address0}]),
+ {Address, IpFamily} =
+ case string:tokens(Address0, [$|]) of
+ [Address1] ->
+ ?hdrv("load BindAddress", [{address1, Address1}]),
+ {clean_address(Address1), inet6fb4};
+ [Address1, IpFamilyStr] ->
+ ?hdrv("load BindAddress",
+ [{address1, Address1},
+ {ipfamily_str, IpFamilyStr}]),
+ {clean_address(Address1), make_ipfamily(IpFamilyStr)};
+ _Bad ->
+ ?hdrv("load BindAddress - bad address",
+ [{bad_address, _Bad}]),
+ throw({error, {bad_bind_address, Address0}})
+ end,
+
+ ?hdrv("load BindAddress - address and ipfamily separated",
+ [{address, Address}, {ipfamily, IpFamily}]),
+
+ case Address of
+ "*" ->
+ {ok, [], [{bind_address, any}, {ipfamily, IpFamily}]};
+ _ ->
+ case httpd_util:ip_address(Address, IpFamily) of
+ {ok, IPAddr} ->
+ ?hdrv("load BindAddress - checked",
+ [{ip_address, IPAddr}]),
+ Entries = [{bind_address, IPAddr},
+ {ipfamily, IpFamily}],
+ {ok, [], Entries};
+ {error, _} ->
+ {error, ?NICE(Address ++ " is an invalid address")}
+ end
+ end
+ end
+ catch
+ throw:{error, {bad_bind_address, _}} ->
+ ?hdrv("load BindAddress - bad bind address", []),
+ {error, ?NICE(Address0 ++ " is an invalid address")};
+ throw:{error, {bad_ipfamily, _}} ->
+ ?hdrv("load BindAddress - bad ipfamily", []),
+ {error, ?NICE(Address0 ++ " has an invalid ipfamily")}
+ end;
+
+load("KeepAlive " ++ OnorOff, []) ->
+ case list_to_atom(clean(OnorOff)) of
+ off ->
+ {ok, [], {keep_alive, false}};
+ _ ->
+ {ok, [], {keep_alive, true}}
+ end;
+
+load("MaxKeepAliveRequests " ++ MaxRequests, []) ->
+ case make_integer(MaxRequests) of
+ {ok, Integer} ->
+ {ok, [], {max_keep_alive_request, Integer}};
+ {error, _} ->
+ {error, ?NICE(clean(MaxRequests) ++
+ " is an invalid MaxKeepAliveRequests")}
+ end;
+
+%% This clause is keept for backwards compability
+load("MaxKeepAliveRequest " ++ 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("KeepAliveTimeout " ++ 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("Modules " ++ Modules, []) ->
+ {ok, ModuleList} = inets_regexp:split(Modules," "),
+ {ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}};
+
+load("ServerAdmin " ++ ServerAdmin, []) ->
+ {ok, [], {server_admin,clean(ServerAdmin)}};
+
+load("ServerRoot " ++ ServerRoot, []) ->
+ case is_directory(clean(ServerRoot)) of
+ {ok, Directory} ->
+ {ok, [], [{server_root,string:strip(Directory,right,$/)}]};
+ {error, _} ->
+ {error, ?NICE(clean(ServerRoot)++" is an invalid ServerRoot")}
+ end;
+
+load("MimeTypes " ++ MimeTypes, []) ->
+ case load_mime_types(clean(MimeTypes)) of
+ {ok, MimeTypesList} ->
+ {ok, [], [{mime_types, MimeTypesList}]};
+ {error, Reason} ->
+ {error, Reason}
+ end;
+
+load("MaxClients " ++ 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("DocumentRoot " ++ 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("DefaultType " ++ DefaultType, []) ->
+ {ok, [], {default_type,clean(DefaultType)}};
+load("SSLCertificateFile " ++ 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("SSLCertificateKeyFile " ++ 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("SSLVerifyClient " ++ SSLVerifyClient, []) ->
+ case make_integer(clean(SSLVerifyClient)) of
+ {ok, Integer} when (Integer >=0) andalso (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("SSLVerifyDepth " ++ 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("SSLCiphers " ++ SSLCiphers, []) ->
+ {ok, [], {ssl_ciphers, clean(SSLCiphers)}};
+load("SSLCACertificateFile " ++ 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("SSLPasswordCallbackModule " ++ SSLPasswordCallbackModule, []) ->
+ {ok, [], {ssl_password_callback_module,
+ list_to_atom(clean(SSLPasswordCallbackModule))}};
+load("SSLPasswordCallbackFunction " ++ SSLPasswordCallbackFunction, []) ->
+ {ok, [], {ssl_password_callback_function,
+ list_to_atom(clean(SSLPasswordCallbackFunction))}};
+load("SSLPasswordCallbackArguments " ++ SSLPasswordCallbackArguments, []) ->
+ {ok, [], {ssl_password_callback_arguments,
+ SSLPasswordCallbackArguments}};
+load("DisableChunkedTransferEncodingSend " ++ TrueOrFalse, []) ->
+ case list_to_atom(clean(TrueOrFalse)) of
+ true ->
+ {ok, [], {disable_chunked_transfer_encoding_send, true}};
+ _ ->
+ {ok, [], {disable_chunked_transfer_encoding_send, false}}
+ end;
+load("LogFormat " ++ LogFormat, []) ->
+ {ok,[],{log_format, list_to_atom(httpd_conf:clean(LogFormat))}};
+load("ErrorLogFormat " ++ LogFormat, []) ->
+ {ok,[],{error_log_format, list_to_atom(httpd_conf:clean(LogFormat))}}.
+
+
+clean_address(Addr) ->
+ string:strip(string:strip(clean(Addr), left, $[), right, $]).
+
+
+make_ipfamily(IpFamilyStr) ->
+ IpFamily = list_to_atom(IpFamilyStr),
+ case lists:member(IpFamily, [inet, inet6, inet6fb4]) of
+ true ->
+ IpFamily;
+ false ->
+ throw({error, {bad_ipfamily, IpFamilyStr}})
+ end.
+
+
+%%
+%% 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.
+
+
+validate_properties(Properties) ->
+ %% First, check that all mandatory properties are present
+ case mandatory_properties(Properties) of
+ ok ->
+ %% Second, check that property dependency are ok
+ {ok, validate_properties2(Properties)};
+ Error ->
+ throw(Error)
+ end.
+
+%% This function is used to validate inter-property dependencies.
+%% That is, if property A depends on property B.
+%% The only sunch preperty at this time is bind_address that depends
+%% on ipfamily.
+validate_properties2(Properties) ->
+ case proplists:get_value(bind_address, Properties) of
+ undefined ->
+ case proplists:get_value(sock_type, Properties, ip_comm) of
+ ip_comm ->
+ case proplists:get_value(ipfamily, Properties) of
+ undefined ->
+ [{bind_address, any},
+ {ipfamily, inet6fb4} | Properties];
+ _ ->
+ [{bind_address, any} | Properties]
+ end;
+ _ ->
+ [{bind_address, any} | Properties]
+ end;
+ any ->
+ Properties;
+ Address0 ->
+ IpFamily = proplists:get_value(ipfamily, Properties, inet6fb4),
+ case httpd_util:ip_address(Address0, IpFamily) of
+ {ok, Address} ->
+ Properties1 = proplists:delete(bind_address, Properties),
+ [{bind_address, Address} | Properties1];
+ {error, Reason} ->
+ Error = {error,
+ {failed_determine_ip_address,
+ Address0, IpFamily, Reason}},
+ throw(Error)
+ end
+ end.
+
+mandatory_properties(ConfigList) ->
+ a_must(ConfigList, [server_name, port, server_root, document_root]).
+
+a_must(_ConfigList, []) ->
+ ok;
+a_must(ConfigList, [Prop | Rest]) ->
+ case proplists:get_value(Prop, ConfigList) of
+ undefined ->
+ {error, {missing_property, Prop}};
+ _ ->
+ a_must(ConfigList, Rest)
+ end.
+
+
+validate_config_params([]) ->
+ ok;
+validate_config_params([{max_header_size, Value} | Rest])
+ when is_integer(Value) andalso (Value > 0) ->
+ validate_config_params(Rest);
+validate_config_params([{max_header_size, Value} | _]) ->
+ throw({max_header_size, Value});
+
+validate_config_params([{max_body_size, Value} | Rest])
+ when is_integer(Value) andalso (Value > 0) ->
+ validate_config_params(Rest);
+validate_config_params([{max_body_size, Value} | _]) ->
+ throw({max_body_size, Value});
+
+validate_config_params([{server_name, Value} | Rest])
+ when is_list(Value) ->
+ validate_config_params(Rest);
+validate_config_params([{server_name, Value} | _]) ->
+ throw({server_name, Value});
+
+validate_config_params([{socket_type, Value} | Rest])
+ when (Value =:= ip_comm) orelse (Value =:= ssl) ->
+ validate_config_params(Rest);
+validate_config_params([{socket_type, Value} | _]) ->
+ throw({socket_type, Value});
+
+validate_config_params([{port, Value} | Rest])
+ when is_integer(Value) andalso (Value >= 0) ->
+ validate_config_params(Rest);
+validate_config_params([{port, Value} | _]) ->
+ throw({port, Value});
+
+validate_config_params([{bind_address, Value} | Rest]) ->
+ case is_bind_address(Value) of
+ true ->
+ validate_config_params(Rest);
+ false ->
+ throw({bind_address, Value})
+ end;
+
+validate_config_params([{ipfamily, Value} | Rest])
+ when ((Value =:= inet) orelse
+ (Value =:= inet6) orelse
+ (Value =:= inet6fb4)) ->
+ validate_config_params(Rest);
+validate_config_params([{ipfamily, Value} | _]) ->
+ throw({ipfamily, Value});
+
+validate_config_params([{keep_alive, Value} | Rest])
+ when (Value =:= true) orelse (Value =:= false) ->
+ validate_config_params(Rest);
+validate_config_params([{keep_alive, Value} | _]) ->
+ throw({keep_alive, Value});
+
+validate_config_params([{max_keep_alive_request, Value} | Rest])
+ when is_integer(Value) andalso (Value > 0) ->
+ validate_config_params(Rest);
+validate_config_params([{max_keep_alive_request, Value} | _]) ->
+ throw({max_header_size, Value});
+
+validate_config_params([{keep_alive_timeout, Value} | Rest])
+ when is_integer(Value) andalso (Value >= 0) ->
+ validate_config_params(Rest);
+validate_config_params([{keep_alive_timeout, Value} | _]) ->
+ throw({keep_alive_timeout, Value});
+
+validate_config_params([{modules, Value} | Rest]) ->
+ ok = httpd_util:modules_validate(Value),
+ validate_config_params(Rest);
+
+validate_config_params([{server_admin, Value} | Rest]) when is_list(Value) ->
+ validate_config_params(Rest);
+validate_config_params([{server_admin, Value} | _]) ->
+ throw({server_admin, Value});
+
+validate_config_params([{server_root, Value} | Rest]) ->
+ ok = httpd_util:dir_validate(server_root, Value),
+ validate_config_params(Rest);
+
+validate_config_params([{mime_types, Value} | Rest]) ->
+ ok = httpd_util:mime_types_validate(Value),
+ validate_config_params(Rest);
+
+validate_config_params([{max_clients, Value} | Rest])
+ when is_integer(Value) andalso (Value > 0) ->
+ validate_config_params(Rest);
+validate_config_params([{max_clients, Value} | _]) ->
+ throw({max_clients, Value});
+
+validate_config_params([{document_root, Value} | Rest]) ->
+ ok = httpd_util:dir_validate(document_root, Value),
+ validate_config_params(Rest);
+
+validate_config_params([{default_type, Value} | Rest]) when is_list(Value) ->
+ validate_config_params(Rest);
+validate_config_params([{default_type, Value} | _]) ->
+ throw({default_type, Value});
+
+validate_config_params([{ssl_certificate_file = Key, Value} | Rest]) ->
+ ok = httpd_util:file_validate(Key, Value),
+ validate_config_params(Rest);
+
+validate_config_params([{ssl_certificate_key_file = Key, Value} | Rest]) ->
+ ok = httpd_util:file_validate(Key, Value),
+ validate_config_params(Rest);
+
+validate_config_params([{ssl_verify_client, Value} | Rest])
+ when (Value =:= 0) orelse (Value =:= 1) orelse (Value =:= 2) ->
+ validate_config_params(Rest);
+
+validate_config_params([{ssl_verify_client_depth, Value} | Rest])
+ when is_integer(Value) andalso (Value >= 0) ->
+ validate_config_params(Rest);
+validate_config_params([{ssl_verify_client_depth, Value} | _]) ->
+ throw({ssl_verify_client_depth, Value});
+
+validate_config_params([{ssl_ciphers, Value} | Rest]) when is_list(Value) ->
+ validate_config_params(Rest);
+validate_config_params([{ssl_ciphers, Value} | _]) ->
+ throw({ssl_ciphers, Value});
+
+validate_config_params([{ssl_ca_certificate_file = Key, Value} | Rest]) ->
+ ok = httpd_util:file_validate(Key, Value),
+ validate_config_params(Rest);
+
+validate_config_params([{ssl_password_callback_module, Value} | Rest])
+ when is_atom(Value) ->
+ validate_config_params(Rest);
+validate_config_params([{ssl_password_callback_module, Value} | _]) ->
+ throw({ssl_password_callback_module, Value});
+
+validate_config_params([{ssl_password_callback_function, Value} | Rest])
+ when is_atom(Value) ->
+ validate_config_params(Rest);
+validate_config_params([{ssl_password_callback_function, Value} | _]) ->
+ throw({ssl_password_callback_function, Value});
+
+validate_config_params([{ssl_password_callback_arguments, Value} | Rest])
+ when is_list(Value) ->
+ validate_config_params(Rest);
+validate_config_params([{ssl_password_callback_arguments, Value} | _]) ->
+ throw({ssl_password_callback_arguments, Value});
+
+validate_config_params([{disable_chunked_transfer_encoding_send, Value} |
+ Rest])
+ when (Value =:= true) orelse (Value =:= false) ->
+ validate_config_params(Rest);
+validate_config_params([{disable_chunked_transfer_encoding_send, Value} |
+ _ ]) ->
+ throw({disable_chunked_transfer_encoding_send, Value});
+validate_config_params([_| Rest]) ->
+ validate_config_params(Rest).
+
+%% It is actually pointless to check bind_address in this way since
+%% we need ipfamily to do it properly...
+is_bind_address(any) ->
+ true;
+is_bind_address(Value) ->
+ case httpd_util:ip_address(Value, inet6fb4) of
+ {ok, _} ->
+ true;
+ _ ->
+ false
+ end.
+
+store(ConfigList0) ->
+ ?hdrd("store", []),
+ try validate_config_params(ConfigList0) of
+ ok ->
+ Modules =
+ proplists:get_value(modules, ConfigList0, ?DEFAULT_MODS),
+ ?hdrt("store", [{modules, Modules}]),
+ Port = proplists:get_value(port, ConfigList0),
+ Addr = proplists:get_value(bind_address, ConfigList0, any),
+ ConfigList = fix_mime_types(ConfigList0),
+ Name = httpd_util:make_name("httpd_conf", Addr, Port),
+ ConfigDB = ets:new(Name, [named_table, bag, protected]),
+ store(ConfigDB, ConfigList,
+ lists:append(Modules, [?MODULE]),
+ ConfigList)
+ catch
+ throw:Error ->
+ {error, {invalid_option, Error}}
+ end.
+
+fix_mime_types(ConfigList0) ->
+ case proplists:get_value(mime_types, ConfigList0) of
+ undefined ->
+ ServerRoot = proplists:get_value(server_root, ConfigList0),
+ MimeTypesFile =
+ filename:join([ServerRoot,"conf", "mime.types"]),
+ case filelib:is_file(MimeTypesFile) of
+ true ->
+ {ok, MimeTypesList} = load_mime_types(MimeTypesFile),
+ [{mime_types, MimeTypesList} | ConfigList0];
+ false ->
+ [{mime_types,
+ [{"html","text/html"},{"htm","text/html"}]}
+ | ConfigList0]
+ end;
+ _ ->
+ ConfigList0
+ end.
+
+store({mime_types,MimeTypesList},ConfigList) ->
+ Port = proplists:get_value(port, ConfigList),
+ Addr = proplists:get_value(bind_address, ConfigList),
+ Name = httpd_util:make_name("httpd_mime",Addr,Port),
+ {ok, MimeTypesDB} = store_mime_types(Name,MimeTypesList),
+ {ok, {mime_types,MimeTypesDB}};
+store({log_format, LogFormat}, _ConfigList)
+ when (LogFormat =:= common) orelse (LogFormat =:= combined) ->
+ {ok,{log_format, LogFormat}};
+store({log_format, LogFormat}, _ConfigList)
+ when (LogFormat =:= compact) orelse (LogFormat =:= pretty) ->
+ {ok, {log_format, LogFormat}};
+store(ConfigListEntry, _ConfigList) ->
+ {ok, ConfigListEntry}.
+
+%% Phase 3: Remove
+remove_all(ConfigDB) ->
+ Modules = httpd_util:lookup(ConfigDB,modules,[]),
+ remove_traverse(ConfigDB, lists:append(Modules,[?MODULE])).
+
+remove(ConfigDB) ->
+ ets:delete(ConfigDB),
+ ok.
+
+config(ConfigDB) ->
+ case httpd_util:lookup(ConfigDB, socket_type,ip_comm) of
+ ssl ->
+ case ssl_certificate_file(ConfigDB) of
+ undefined ->
+ {error,
+ "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.
+
+
+get_config(Address, Port) ->
+ Tab = httpd_util:make_name("httpd_conf", Address, Port),
+ Properties = ets:tab2list(Tab),
+ MimeTab = proplists:get_value(mime_types, Properties),
+ NewProperties = proplists:delete(mime_types, Properties),
+ [{mime_types, ets:tab2list(MimeTab)} | NewProperties].
+
+get_config(Address, Port, Properties) ->
+ Tab = httpd_util:make_name("httpd_conf", Address, Port),
+ Config =
+ lists:map(fun(Prop) -> {Prop, httpd_util:lookup(Tab, Prop)} end,
+ Properties),
+ [{Proporty, Value} || {Proporty, Value} <- Config, Value =/= undefined].
+
+
+lookup(Tab, Key) ->
+ httpd_util:lookup(Tab, Key).
+
+lookup(Tab, Key, Default) when is_atom(Key) ->
+ httpd_util:lookup(Tab, Key, Default);
+
+lookup(Address, Port, Key) when is_integer(Port) ->
+ Tab = table(Address, Port),
+ lookup(Tab, Key).
+
+lookup(Address, Port, Key, Default) when is_integer(Port) ->
+ Tab = table(Address, Port),
+ lookup(Tab, Key, Default).
+
+table(Address, Port) ->
+ httpd_util:make_name("httpd_conf", Address, Port).
+
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+%%% Phase 1 Load:
+bootstrap([]) ->
+ {ok, ?DEFAULT_MODS};
+bootstrap([Line|Config]) ->
+ case Line of
+ "Modules " ++ Modules ->
+ {ok, ModuleList} = inets_regexp:split(Modules," "),
+ TheMods = [list_to_atom(X) || X <- ModuleList],
+ case verify_modules(TheMods) of
+ ok ->
+ {ok, TheMods};
+ {error, Reason} ->
+ {error, Reason}
+ end;
+ _ ->
+ bootstrap(Config)
+ end.
+
+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) ->
+ ?hdrv("config loaded", []),
+ {ok, ConfigList};
+
+load_config([Line|Config], Modules, Contexts, ConfigList) ->
+ ?hdrt("load config", [{config_line, Line}]),
+ case load_traverse(Line, Contexts, Modules, [], ConfigList, no) of
+ {ok, NewContexts, NewConfigList} ->
+ load_config(Config, Modules, NewContexts, NewConfigList);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+
+%% 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_traverse(Line, [], [], _NewContexts, _ConfigList, no) ->
+ {error, ?NICE("Configuration directive not recognized: "++Line)};
+load_traverse(_Line, [], [], NewContexts, ConfigList, yes) ->
+ {ok, lists:reverse(NewContexts), ConfigList};
+load_traverse(Line, [Context|Contexts], [Module|Modules], NewContexts,
+ ConfigList, State) ->
+ ?hdrt("load config traverse",
+ [{context, Context}, {httpd_module, Module}, {state, State}]),
+ case catch apply(Module, load, [Line, Context]) of
+ {'EXIT', {function_clause, _FC}} ->
+ ?hdrt("does not handle load config",
+ [{config_line, Line}, {fc, _FC}]),
+ load_traverse(Line, Contexts, Modules,
+ [Context|NewContexts], ConfigList, State);
+
+ {'EXIT', {undef, _}} ->
+ ?hdrt("does not implement load", []),
+ load_traverse(Line, Contexts, Modules,
+ [Context|NewContexts], ConfigList,yes);
+
+ {'EXIT', Reason} ->
+ error_logger:error_report({'EXIT', Reason}),
+ load_traverse(Line, Contexts, Modules,
+ [Context|NewContexts], ConfigList, State);
+
+ {ok, NewContext} ->
+ ?hdrt("line processed", [{new_context, NewContext}]),
+ load_traverse(Line, Contexts, Modules,
+ [NewContext|NewContexts], ConfigList,yes);
+
+ {ok, NewContext, ConfigEntry} when is_tuple(ConfigEntry) ->
+ ?hdrt("line processed",
+ [{new_context, NewContext}, {config_entry, ConfigEntry}]),
+ load_traverse(Line, Contexts,
+ Modules, [NewContext|NewContexts],
+ [ConfigEntry|ConfigList], yes);
+
+ {ok, NewContext, ConfigEntry} when is_list(ConfigEntry) ->
+ ?hdrt("line processed",
+ [{new_context, NewContext}, {config_entry, ConfigEntry}]),
+ load_traverse(Line, Contexts, Modules, [NewContext|NewContexts],
+ lists:append(ConfigEntry, ConfigList), yes);
+
+ {error, Reason} ->
+ ?hdrv("line processing failed", [{reason, Reason}]),
+ {error, Reason}
+ end.
+
+%% 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.
+
+%% 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 ->
+ file:close(Stream),
+ {ok, lists:reverse(SoFar)};
+ {error, Reason} ->
+ file:close(Stream),
+ {error, Reason};
+ [$#|_Rest] ->
+ %% Ignore commented lines for efficiency later ..
+ read_config_file(Stream, SoFar);
+ Line ->
+ {ok, NewLine, _}=inets_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.
+
+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 inets_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(ConfigDB, _ConfigList, _Modules, []) ->
+ {ok, ConfigDB};
+store(ConfigDB, ConfigList, Modules, [ConfigListEntry|Rest]) ->
+ ?hdrt("store", [{entry, ConfigListEntry}]),
+ case store_traverse(ConfigListEntry, ConfigList, Modules) of
+ {ok, ConfigDBEntry} when is_tuple(ConfigDBEntry) ->
+ ets:insert(ConfigDB, ConfigDBEntry),
+ store(ConfigDB, ConfigList, Modules, Rest);
+ {ok, ConfigDBEntry} when is_list(ConfigDBEntry) ->
+ lists:foreach(fun(Entry) ->
+ ets:insert(ConfigDB,Entry)
+ end,ConfigDBEntry),
+ store(ConfigDB, ConfigList, Modules, Rest);
+ {error, Reason} ->
+ {error,Reason}
+ end.
+
+store_traverse(_ConfigListEntry, _ConfigList,[]) ->
+ {error, ?NICE("Unable to store configuration...")};
+store_traverse(ConfigListEntry, ConfigList, [Module|Rest]) ->
+ ?hdrt("store traverse",
+ [{httpd_module, Module}, {entry, ConfigListEntry}]),
+ case catch apply(Module, store, [ConfigListEntry, ConfigList]) of
+ {'EXIT',{function_clause,_}} ->
+ ?hdrt("does not handle store config", []),
+ store_traverse(ConfigListEntry,ConfigList,Rest);
+ {'EXIT',{undef, _}} ->
+ ?hdrt("does not implement store", []),
+ store_traverse(ConfigListEntry,ConfigList,Rest);
+ {'EXIT', Reason} ->
+ error_logger:error_report({'EXIT',Reason}),
+ store_traverse(ConfigListEntry,ConfigList,Rest);
+ Result ->
+ ?hdrt("config entry processed", [{result, Result}]),
+ Result
+ end.
+
+store_mime_types(Name,MimeTypesList) ->
+ %% Make sure that the ets table is not duplicated
+ %% when reloading configuration
+ catch ets:delete(Name),
+ MimeTypesDB = ets:new(Name, [named_table, set, protected]),
+ store_mime_types1(MimeTypesDB, MimeTypesList).
+store_mime_types1(MimeTypesDB,[]) ->
+ {ok, MimeTypesDB};
+store_mime_types1(MimeTypesDB,[Type|Rest]) ->
+ ets:insert(MimeTypesDB, Type),
+ store_mime_types1(MimeTypesDB, Rest).
+
+
+%% Phase 3: remove
+remove_traverse(_ConfigDB,[]) ->
+ ok;
+remove_traverse(ConfigDB,[Module|Rest]) ->
+ case (catch apply(Module,remove,[ConfigDB])) of
+ {'EXIT',{undef,_}} ->
+ remove_traverse(ConfigDB,Rest);
+ {'EXIT',{function_clause,_}} ->
+ remove_traverse(ConfigDB,Rest);
+ {'EXIT',Reason} ->
+ error_logger:error_report({'EXIT',Reason}),
+ remove_traverse(ConfigDB,Rest);
+ {error,Reason} ->
+ error_logger:error_report(Reason),
+ remove_traverse(ConfigDB,Rest);
+ _ ->
+ remove_traverse(ConfigDB,Rest)
+ 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 ->
+ Args = case httpd_util:lookup(ConfigDB,
+ ssl_password_callback_arguments) of
+ undefined ->
+ [];
+ Arguments ->
+ [Arguments]
+ end,
+
+ case catch apply(Module, Function, Args) of
+ Password when is_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/inets/src/http_server/httpd_esi.erl b/lib/inets/src/http_server/httpd_esi.erl
new file mode 100644
index 0000000000..b1a75fda52
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_esi.erl
@@ -0,0 +1,108 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_esi).
+
+-export([parse_headers/1, handle_headers/1]).
+
+-include("inets_internal.hrl").
+
+%%%=========================================================================
+%%% Internal application API
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% parse_headers(Data) -> {Headers, Body}
+%%
+%% Data = string() | io_list()
+%% Headers = string()
+%% Body = io_list()
+%%
+%% Description: Parses <Data> and divides it to a header part and a
+%% body part. Note that it is presumed that <Data> starts with a
+%% string including "\r\n\r\n" if there is any header information
+%% present. The returned headers will not contain the HTTP header body
+%% delimiter \r\n. (All header, header delimiters are keept.)
+%% Ex: ["Content-Type : text/html\r\n Connection : closing \r\n\r\n" |
+%% io_list()] --> {"Content-Type : text/html\r\n Connection : closing \r\n",
+%% io_list()}
+%%--------------------------------------------------------------------------
+parse_headers(Data) ->
+ parse_headers(Data, []).
+
+%%--------------------------------------------------------------------------
+%% handle_headers(Headers) -> {ok, HTTPHeaders, StatusCode} |
+%% {proceed, AbsPath}
+%% Headers = string()
+%% HTTPHeaders = [{HeaderField, HeaderValue}]
+%% HeaderField = string()
+%% HeaderValue = string()
+%% StatusCode = integer()
+%%
+%% Description: Transforms the plain HTTP header string data received
+%% from the ESI program into a list of header values and an
+%% appropriate HTTP status code. Note if a location header is present
+%% the return value will be {proceed, AbsPath}
+%%--------------------------------------------------------------------------
+handle_headers("") ->
+ {ok, [], 200};
+handle_headers(Headers) ->
+ NewHeaders = string:tokens(Headers, ?CRLF),
+ handle_headers(NewHeaders, [], 200).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+parse_headers([], Acc) ->
+ {[], lists:reverse(Acc)};
+parse_headers([?CR, ?LF, ?CR, ?LF], Acc) ->
+ {lists:reverse(Acc) ++ [?CR, ?LF], []};
+parse_headers([?CR, ?LF, ?CR, ?LF | Rest], Acc) ->
+ {lists:reverse(Acc) ++ [?CR, ?LF], Rest};
+parse_headers([Char | Rest], Acc) ->
+ parse_headers(Rest, [Char | Acc]).
+
+handle_headers([], NewHeaders, StatusCode) ->
+ {ok, NewHeaders, StatusCode};
+
+handle_headers([Header | Headers], NewHeaders, StatusCode) ->
+ {FieldName, FieldValue} = httpd_response:split_header(Header, []),
+ case FieldName of
+ "location" ->
+ case http_request:is_absolut_uri(FieldValue) of
+ true ->
+ handle_headers(Headers,
+ [{FieldName, FieldValue} | NewHeaders],
+ 302);
+ false ->
+ {proceed, FieldValue}
+ end;
+ "status" ->
+ NewStatusCode =
+ case httpd_util:split(FieldValue," ",2) of
+ {ok,[Code,_]} ->
+ list_to_integer(Code);
+ _ ->
+ 200
+ end,
+ handle_headers(Headers, NewHeaders, NewStatusCode);
+ _ ->
+ handle_headers(Headers,
+ [{FieldName, FieldValue}| NewHeaders], StatusCode)
+ end.
diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl
new file mode 100644
index 0000000000..16a080f8e2
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_example.erl
@@ -0,0 +1,145 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_example).
+-export([print/1]).
+-export([get/2, post/2, yahoo/2, test1/2, get_bin/2]).
+
+-export([newformat/3]).
+%% These are used by the inets test-suite
+-export([delay/1]).
+
+
+print(String) ->
+ [header(),
+ top("Print"),
+ String++"\n",
+ footer()].
+
+test1(Env, []) ->
+ io:format("Env:~p~n",[Env]),
+ ["<html>",
+ "<head>",
+ "<title>Test1</title>",
+ "</head>",
+ "<body>",
+ "<h1>Erlang Body</h1>",
+ "<h2>Stuff</h2>",
+ "</body>",
+ "</html>"].
+
+
+get(_Env,[]) ->
+ [header(),
+ top("GET Example"),
+ "<FORM ACTION=\"/cgi-bin/erl/httpd_example:get\" METHOD=GET>
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n",
+ footer()];
+
+get(Env,Input) ->
+ default(Env,Input).
+
+get_bin(_Env,_Input) ->
+ [list_to_binary(header()),
+ list_to_binary(top("GET Example")),
+ list_to_binary("<FORM ACTION=\"/cgi-bin/erl/httpd_example:get\" METHOD=GET>
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n"),
+ footer()].
+
+post(_Env,[]) ->
+ [header(),
+ top("POST Example"),
+ "<FORM ACTION=\"/cgi-bin/erl/httpd_example:post\" METHOD=POST>
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n",
+ footer()];
+
+post(Env,Input) ->
+ default(Env,Input).
+
+yahoo(_Env,_Input) ->
+ "Location: http://www.yahoo.com\r\n\r\n".
+
+default(Env,Input) ->
+ [header(),
+ top("Default Example"),
+ "<B>Environment:</B> ",io_lib:format("~p",[Env]),"<BR>\n",
+ "<B>Input:</B> ",Input,"<BR>\n",
+ "<B>Parsed Input:</B> ",
+ io_lib:format("~p",[httpd:parse_query(Input)]),"\n",
+ footer()].
+
+header() ->
+ header("text/html").
+header(MimeType) ->
+ "Content-type: " ++ MimeType ++ "\r\n\r\n".
+
+top(Title) ->
+ "<HTML>
+<HEAD>
+<TITLE>" ++ Title ++ "</TITLE>
+</HEAD>
+<BODY>\n".
+
+footer() ->
+ "</BODY>
+</HTML>\n".
+
+
+newformat(SessionID, _Env, _Input)->
+ mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"),
+ mod_esi:deliver(SessionID, top("new esi format test")),
+ mod_esi:deliver(SessionID, "This new format is nice<BR>"),
+ mod_esi:deliver(SessionID, "This new format is nice<BR>"),
+ mod_esi:deliver(SessionID, "This new format is nice<BR>"),
+ mod_esi:deliver(SessionID, footer()).
+
+%% ------------------------------------------------------
+
+delay(Time) when is_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 is_list(Time) ->
+ delay(httpd_conf:make_integer(Time));
+delay({ok,Time}) when is_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/inets/src/http_server/httpd_file.erl b/lib/inets/src/http_server/httpd_file.erl
new file mode 100644
index 0000000000..5fd529100e
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_file.erl
@@ -0,0 +1,45 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_file).
+
+-export([handle_error/4]).
+
+-include("httpd.hrl").
+
+handle_error(eacces, Op, ModData, Path) ->
+ handle_error(403, Op, ModData, Path,"");
+handle_error(enoent, Op, ModData, Path) ->
+ handle_error(404, Op, ModData, Path,"");
+handle_error(enotdir, Op, ModData, Path) ->
+ handle_error(404, Op, ModData, Path,
+ ": A component of the file name is not a directory");
+handle_error(emfile, Op, _ModData, Path) ->
+ handle_error(500, Op, none, Path, ": To many open files");
+handle_error({enfile,_}, Op, _ModData, Path) ->
+ handle_error(500, Op, none, Path, ": File table overflow");
+handle_error(_Reason, Op, _ModData, Path) ->
+ handle_error(500, Op, none, Path, "").
+
+handle_error(StatusCode, Op, none, Path, Reason) ->
+ {StatusCode, none, ?NICE("Can't " ++ Op ++ Path ++ Reason)};
+
+handle_error(StatusCode, Op, ModData, Path, Reason) ->
+ {StatusCode, ModData#mod.request_uri,
+ ?NICE("Can't " ++ Op ++ Path ++ Reason)}.
diff --git a/lib/inets/src/http_server/httpd_instance_sup.erl b/lib/inets/src/http_server/httpd_instance_sup.erl
new file mode 100644
index 0000000000..3b5464132c
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_instance_sup.erl
@@ -0,0 +1,169 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for an instance of the http server. (You may
+%% have several instances running on the same machine.) Hangs under
+%% httpd_sup.
+%%----------------------------------------------------------------------
+
+-module(httpd_instance_sup).
+
+-behaviour(supervisor).
+
+%% Internal application API
+-export([start_link/3, start_link/4]).
+
+%% Supervisor callbacks
+-export([init/1]).
+
+%%%=========================================================================
+%%% Internal Application API
+%%%=========================================================================
+start_link([{_, _}| _] = Config, AcceptTimeout, Debug) ->
+ case httpd_conf:validate_properties(Config) of
+ {ok, Config2} ->
+ Address = proplists:get_value(bind_address, Config2),
+ Port = proplists:get_value(port, Config2),
+ Name = make_name(Address, Port),
+ SupName = {local, Name},
+ supervisor:start_link(SupName, ?MODULE,
+ [undefined, Config2, AcceptTimeout,
+ Debug, Address, Port]);
+ {error, Reason} ->
+ error_logger:error_report(Reason),
+ {stop, Reason}
+ end;
+
+start_link(ConfigFile, AcceptTimeout, Debug) ->
+ case file_2_config(ConfigFile) of
+ {ok, ConfigList, Address, Port} ->
+ Name = make_name(Address, Port),
+ SupName = {local, Name},
+ supervisor:start_link(SupName, ?MODULE,
+ [ConfigFile, ConfigList, AcceptTimeout,
+ Debug, Address, Port]);
+ {error, Reason} ->
+ error_logger:error_report(Reason),
+ {stop, Reason}
+ end.
+
+
+start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) ->
+ case httpd_conf:validate_properties(Config) of
+ {ok, Config2} ->
+ Address = proplists:get_value(bind_address, Config2),
+ Port = proplists:get_value(port, Config2),
+ Name = make_name(Address, Port),
+ SupName = {local, Name},
+ supervisor:start_link(SupName, ?MODULE,
+ [undefined, Config2, AcceptTimeout,
+ Debug, Address, Port, ListenInfo]);
+ {error, Reason} ->
+ error_logger:error_report(Reason),
+ {stop, Reason}
+ end;
+
+start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) ->
+ case file_2_config(ConfigFile) of
+ {ok, ConfigList, Address, Port} ->
+ Name = make_name(Address, Port),
+ SupName = {local, Name},
+ supervisor:start_link(SupName, ?MODULE,
+ [ConfigFile, ConfigList, AcceptTimeout,
+ Debug, Address, Port, ListenInfo]);
+ {error, Reason} ->
+ error_logger:error_report(Reason),
+ {stop, Reason}
+ end.
+
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+init([ConfigFile, ConfigList, AcceptTimeout, _Debug, Address, Port]) ->
+ Flags = {one_for_one, 0, 1},
+ Children = [sup_spec(httpd_acceptor_sup, Address, Port),
+ sup_spec(httpd_misc_sup, Address, Port),
+ worker_spec(httpd_manager, Address, Port,
+ ConfigFile, ConfigList,AcceptTimeout)],
+ {ok, {Flags, Children}};
+init([ConfigFile, ConfigList, AcceptTimeout, _Debug, Address, Port, ListenInfo]) ->
+ Flags = {one_for_one, 0, 1},
+ Children = [sup_spec(httpd_acceptor_sup, Address, Port),
+ sup_spec(httpd_misc_sup, Address, Port),
+ worker_spec(httpd_manager, Address, Port, ListenInfo,
+ ConfigFile, ConfigList, AcceptTimeout)],
+ {ok, {Flags, Children}}.
+
+
+%%%=========================================================================
+%%% Internal functions
+%%%=========================================================================
+sup_spec(SupModule, Address, Port) ->
+ Name = {SupModule, Address, Port},
+ StartFunc = {SupModule, start_link, [Address, Port]},
+ Restart = permanent,
+ Shutdown = infinity,
+ Modules = [SupModule],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+worker_spec(WorkerModule, Address, Port, ConfigFile,
+ ConfigList, AcceptTimeout) ->
+ Name = {WorkerModule, Address, Port},
+ StartFunc = {WorkerModule, start_link,
+ [ConfigFile, ConfigList, AcceptTimeout]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [WorkerModule],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile,
+ ConfigList, AcceptTimeout) ->
+ Name = {WorkerModule, Address, Port},
+ StartFunc = {WorkerModule, start_link,
+ [ConfigFile, ConfigList, AcceptTimeout, ListenInfo]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [WorkerModule],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+make_name(Address,Port) ->
+ httpd_util:make_name("httpd_instance_sup", Address, Port).
+
+
+file_2_config(ConfigFile) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ case httpd_conf:validate_properties(ConfigList) of
+ {ok, Config} ->
+ Address = proplists:get_value(bind_address, ConfigList),
+ Port = proplists:get_value(port, ConfigList),
+ {ok, Config, Address, Port};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+
diff --git a/lib/inets/src/http_server/httpd_internal.hrl b/lib/inets/src/http_server/httpd_internal.hrl
new file mode 100644
index 0000000000..7795ab6c18
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_internal.hrl
@@ -0,0 +1,31 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-ifndef(httpd_internal_hrl).
+-define(httpd_internal_hrl, true).
+
+-include("inets_internal.hrl").
+-define(SERVICE, httpd).
+-define(hdri(Label, Content), ?report_important(Label, ?SERVICE, Content)).
+-define(hdrv(Label, Content), ?report_verbose(Label, ?SERVICE, Content)).
+-define(hdrd(Label, Content), ?report_debug(Label, ?SERVICE, Content)).
+-define(hdrt(Label, Content), ?report_trace(Label, ?SERVICE, Content)).
+
+-endif. % -ifdef(httpd_internal_hrl).
diff --git a/lib/inets/src/http_server/httpd_log.erl b/lib/inets/src/http_server/httpd_log.erl
new file mode 100644
index 0000000000..f3ea3aa0e2
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_log.erl
@@ -0,0 +1,121 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_log).
+
+-include("httpd.hrl").
+
+-export([access_entry/8, error_entry/5, error_report_entry/5,
+ security_entry/5]).
+
+%%%=========================================================================
+%%% Internal Application API
+%%%=========================================================================
+access_entry(Log, NoLog, Info, RFC931, AuthUser, Date, StatusCode, Bytes) ->
+ ConfigDB = Info#mod.config_db,
+ case httpd_util:lookup(ConfigDB, Log) of
+ undefined ->
+ NoLog;
+ LogRef ->
+ {_, RemoteHost}
+ = (Info#mod.init_data)#init_data.peername,
+ RequestLine = Info#mod.request_line,
+ Headers = Info#mod.parsed_header,
+ Entry = do_access_entry(ConfigDB, Headers, RequestLine,
+ RemoteHost, RFC931, AuthUser,
+ Date, StatusCode, Bytes),
+ {LogRef, Entry}
+ end.
+
+error_entry(Log, NoLog, Info, Date, Reason) ->
+ ConfigDB = Info#mod.config_db,
+ case httpd_util:lookup(ConfigDB, Log) of
+ undefined ->
+ NoLog;
+ LogRef ->
+ {_, RemoteHost} =
+ (Info#mod.init_data)#init_data.peername,
+ URI = Info#mod.request_uri,
+ Entry = do_error_entry(ConfigDB, RemoteHost, URI, Date, Reason),
+ {LogRef, Entry}
+ end.
+
+error_report_entry(Log, NoLog, ConfigDb, Date, ErrorStr) ->
+ case httpd_util:lookup(ConfigDb, Log) of
+ undefined ->
+ NoLog;
+ LogRef ->
+ Entry = io_lib:format("[~s], ~s~n", [Date, ErrorStr]),
+ {LogRef, Entry}
+ end.
+
+security_entry(Log, NoLog, #mod{config_db = ConfigDb}, Date, Reason) ->
+ case httpd_util:lookup(ConfigDb, Log) of
+ undefined ->
+ NoLog;
+ LogRef ->
+ Entry = io_lib:format("[~s] ~s~n", [Date, Reason]),
+ {LogRef, Entry}
+ end.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+do_access_entry(ConfigDB, Headers, RequestLine,
+ RemoteHost, RFC931, AuthUser, Date, StatusCode,
+ Bytes) ->
+ case httpd_util:lookup(ConfigDB, log_format, common) of
+ common ->
+ lists:flatten(io_lib:format("~s ~s ~s [~s] \"~s\" ~w ~w~n",
+ [RemoteHost, RFC931, AuthUser, Date,
+ RequestLine,
+ StatusCode, Bytes]));
+ combined ->
+ Referer =
+ proplists:get_value("referer", Headers, "-"),
+ UserAgent =
+ proplists:get_value("user-agent",
+ Headers, "-"),
+ io_lib:format("~s ~s ~s [~s] \"~s\" ~w ~w ~s ~s~n",
+ [RemoteHost, RFC931, AuthUser, Date,
+ RequestLine, StatusCode, Bytes,
+ Referer, UserAgent])
+ end.
+
+
+do_error_entry(ConfigDB, RemoteHost, undefined, Date, Reason) ->
+ case httpd_util:lookup(ConfigDB, error_log_format, pretty) of
+ pretty ->
+ io_lib:format("[~s] server crash for ~s, reason: ~n~p~n~n",
+ [Date, RemoteHost, Reason]);
+ compact ->
+ io_lib:format("[~s] server crash for ~s, reason: ~w~n",
+ [Date, RemoteHost, Reason])
+
+ end;
+
+do_error_entry(ConfigDB, RemoteHost, URI, Date, Reason) ->
+ case httpd_util:lookup(ConfigDB, error_log_format, pretty) of
+ pretty ->
+ io_lib:format("[~s] access to ~s failed for ~s reason: ~n~p~n",
+ [Date, URI, RemoteHost, Reason]);
+ compact ->
+ io_lib:format( "[~s] access to ~s failed for ~s, reason: ~w~n",
+ [Date, URI, RemoteHost, Reason])
+ end.
diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl
new file mode 100644
index 0000000000..f2e8763907
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_manager.erl
@@ -0,0 +1,890 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(httpd_manager).
+
+-include("httpd.hrl").
+
+-behaviour(gen_server).
+
+%% Application internal API
+-export([start/2, start_link/2, start_link/3, start_link/4, stop/1, reload/2]).
+-export([new_connection/1, done_connection/1]).
+-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([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 = []}).
+
+
+%%TODO: Clean up this module!
+
+c(Port) ->
+ Ref = httpd_util:make_name("httpd",undefined,Port),
+ call(Ref, fake_close).
+
+%%
+%% External API
+%%
+%% Deprecated
+start(ConfigFile, ConfigList) ->
+ Port = proplists:get_value(port,ConfigList,80),
+ Addr = proplists:get_value(bind_address, ConfigList),
+ Name = make_name(Addr,Port),
+ gen_server:start({local,Name},?MODULE,
+ [ConfigFile, ConfigList, 15000, Addr, Port],[]).
+
+%% Deprecated
+start_link(ConfigFile, ConfigList) ->
+ start_link(ConfigFile, ConfigList, 15000).
+
+start_link(ConfigFile, ConfigList, AcceptTimeout) ->
+ Port = proplists:get_value(port, ConfigList, 80),
+ Addr = proplists:get_value(bind_address, ConfigList),
+ Name = make_name(Addr, Port),
+
+ gen_server:start_link({local, Name},?MODULE,
+ [ConfigFile, ConfigList, AcceptTimeout, Addr, Port],[]).
+
+start_link(ConfigFile, ConfigList, AcceptTimeout, ListenSocket) ->
+ Port = proplists:get_value(port, ConfigList, 80),
+ Addr = proplists:get_value(bind_address, ConfigList),
+ Name = make_name(Addr, Port),
+
+ gen_server:start_link({local, Name},?MODULE,
+ [ConfigFile, ConfigList, AcceptTimeout, Addr,
+ Port, ListenSocket],[]).
+
+stop(ServerRef) ->
+ call(ServerRef, stop).
+
+reload(ServerRef, Conf) ->
+ call(ServerRef, {reload, Conf}).
+
+
+%%%----------------------------------------------------------------
+
+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).
+
+%%
+%% Internal API
+%%
+
+
+%% new_connection
+
+new_connection(Manager) ->
+ gen_server:call(Manager, {new_connection, self()}, infinity).
+
+%% 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, AcceptTimeout, Addr, Port]) ->
+ process_flag(trap_exit, true),
+ case (catch do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port)) of
+ {error, Reason} ->
+ String = lists:flatten(
+ io_lib:format("Failed initiating "
+ "web server: ~n~p~n~p~n",
+ [ConfigFile,Reason])),
+ error_logger:error_report(String),
+ {stop, {error, Reason}};
+ {ok, State} ->
+ {ok, State}
+ end;
+init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port,
+ ListenInfo]) ->
+ process_flag(trap_exit, true),
+ case (catch do_init(ConfigFile, ConfigList, AcceptTimeout,
+ Addr, Port, ListenInfo)) of
+ {error, Reason} ->
+ String = lists:flatten(
+ io_lib:format("Failed initiating "
+ "web server: ~n~p~n~p~n",
+ [ConfigFile,Reason])),
+ error_logger:error_report(String),
+ {stop, {error, Reason}};
+ {ok, State} ->
+ {ok, State}
+ end.
+
+do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) ->
+ NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile),
+ ConfigDB = do_initial_store(ConfigList),
+ SocketType = httpd_conf:config(ConfigDB),
+ case httpd_acceptor_sup:start_acceptor(SocketType, Addr,
+ Port, ConfigDB, AcceptTimeout) of
+ {ok, _Pid} ->
+ Status = [{max_conn,0}, {last_heavy_load,never},
+ {last_connection,never}],
+ State = #state{socket_type = SocketType,
+ config_file = NewConfigFile,
+ config_db = ConfigDB,
+ connections = [],
+ status = Status},
+ {ok, State};
+ Else ->
+ Else
+ end.
+
+do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo) ->
+ NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile),
+ ConfigDB = do_initial_store(ConfigList),
+ SocketType = httpd_conf:config(ConfigDB),
+ case httpd_acceptor_sup:start_acceptor(SocketType, Addr,
+ Port, ConfigDB,
+ AcceptTimeout, ListenInfo) of
+ {ok, _Pid} ->
+ Status = [{max_conn,0}, {last_heavy_load,never},
+ {last_connection,never}],
+ State = #state{socket_type = SocketType,
+ config_file = NewConfigFile,
+ config_db = ConfigDB,
+ connections = [],
+ status = Status},
+ {ok, State};
+ Else ->
+ Else
+ end.
+
+do_initial_store(ConfigList) ->
+ case httpd_conf:store(ConfigList) of
+ {ok, ConfigDB} ->
+ ConfigDB;
+ {error, Reason} ->
+ throw({error, Reason})
+ end.
+
+
+
+%% handle_call
+
+handle_call(stop, _From, State) ->
+ {stop, normal, ok, State};
+
+handle_call({config_lookup, Query}, _From, State) ->
+ Res = httpd_util:lookup(State#state.config_db, Query),
+ {reply, Res, State};
+
+handle_call({config_multi_lookup, Query}, _From, State) ->
+ Res = httpd_util:multi_lookup(State#state.config_db, Query),
+ {reply, Res, State};
+
+handle_call({config_match, Query}, _From, State) ->
+ Res = ets:match_object(State#state.config_db, Query),
+ {reply, Res, State};
+
+handle_call(get_status, _From, State) ->
+ ManagerStatus = manager_status(self()),
+ S1 = [{current_conn,length(State#state.connections)}|State#state.status]++
+ [ManagerStatus],
+ {reply,S1,State};
+
+handle_call(is_busy, _From, State) ->
+ Reply = case get_ustate(State) of
+ busy ->
+ true;
+ _ ->
+ false
+ end,
+ {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,
+ {reply,Reply,State};
+
+handle_call(is_blocked, _From, State) ->
+ Reply =
+ case get_astate(State) of
+ unblocked ->
+ false;
+ _ ->
+ true
+ end,
+ {reply,Reply,State};
+
+handle_call(get_admin_state, _From, State) ->
+ Reply = get_astate(State),
+ {reply,Reply,State};
+
+handle_call(get_usage_state, _From, State) ->
+ Reply = get_ustate(State),
+ {reply,Reply,State};
+
+handle_call({reload, Conf}, _From, State)
+ when State#state.admin_state =:= blocked ->
+ case handle_reload(Conf, State) of
+ {stop, Reply,S1} ->
+ {stop, Reply, S1};
+ {_, Reply, S1} ->
+ {reply,Reply,S1}
+ end;
+
+handle_call({reload, _}, _From, State) ->
+ {reply,{error,{invalid_admin_state,State#state.admin_state}},State};
+
+handle_call(block, _From, State) ->
+ {Reply,S1} = handle_block(State),
+ {reply,Reply,S1};
+
+handle_call(unblock, {From,_Tag}, State) ->
+ {Reply,S1} = handle_unblock(State,From),
+ {reply, Reply, S1};
+
+handle_call({new_connection, Pid}, _From, State) ->
+ {Status, NewState} = handle_new_connection(State, Pid),
+ {reply, Status, NewState};
+
+handle_call(Request, From, State) ->
+ 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) ->
+ S1 = handle_done_connection(State, Pid),
+ {noreply, S1};
+
+handle_cast({block, disturbing, Timeout, From, Ref}, State) ->
+ S1 = handle_block(State, Timeout, From, Ref),
+ {noreply,S1};
+
+handle_cast({block, non_disturbing, Timeout, From, Ref}, State) ->
+ S1 = handle_nd_block(State, Timeout, From, Ref),
+ {noreply,S1};
+
+handle_cast(Message, State) ->
+ 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) ->
+ S1 = handle_block_timeout(State,Method),
+ {noreply, S1};
+
+handle_info({'DOWN', Ref, process, _Object, _Info}, State) ->
+ S1 =
+ case State#state.blocker_ref of
+ Ref ->
+ handle_blocker_exit(State);
+ _ ->
+ %% Not our blocker, so ignore
+ State
+ end,
+ {noreply, S1};
+
+handle_info({'EXIT', _, normal}, State) ->
+ {noreply, State};
+
+handle_info({'EXIT', _, blocked}, S) ->
+ {noreply, S};
+
+handle_info({'EXIT', Pid, Reason}, State) ->
+ S1 = check_connections(State, Pid, Reason),
+ {noreply, S1};
+
+handle_info(Info, State) ->
+ String =
+ lists:flatten(
+ io_lib:format("Unknown info "
+ "~n ~p"
+ "~nto manager (~p)",
+ [Info, self()])),
+ report_error(State, String),
+ {noreply, State}.
+
+
+%% terminate
+
+terminate(_, #state{config_db = Db}) ->
+ httpd_conf:remove_all(Db),
+ ok.
+
+
+%% code_change({down,ToVsn}, State, Extra)
+%%
+
+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),
+ demonitor_blocker(State#state.blocker_ref),
+ {Tmr,From,Ref} = State#state.blocking_tmr,
+ stop_block_tmr(Tmr),
+ 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;
+ NewConnections ->
+ String =
+ lists:flatten(
+ io_lib:format("request handler (~p) crashed:"
+ "~n ~p", [Pid, Reason])),
+ report_error(State, String),
+ State#state{connections = NewConnections}
+ 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),
+ {{ok, 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
+ demonitor_blocker(State#state.blocker_ref),
+ {Tmr,From,Ref} = State#state.blocking_tmr,
+ stop_block_tmr(Tmr),
+ 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
+ [kill_handler(Pid) || Pid <- S#state.connections],
+ {ok,S#state{connections = [], admin_state = blocked}};
+handle_block(S,blocked) ->
+ {ok,S};
+handle_block(S,shutting_down) ->
+ {{error,shutting_down},S}.
+
+
+kill_handler(Pid) ->
+ exit(Pid, blocked).
+
+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
+ From ! {block_reply,ok,Ref},
+ S#state{admin_state = blocked};
+ _ ->
+ %% Active or Busy usage state => go to shutting_down
+ %% Make sure we get to know if blocker dies...
+ MonitorRef = monitor_blocker(From),
+ 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
+ From ! {block_reply,ok,Ref},
+ S#state{admin_state = blocked};
+ _ ->
+ %% Active or Busy usage state => go to shutting_down
+ %% Make sure we get to know if blocker dies...
+ MonitorRef = monitor_blocker(From),
+ 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}) ->
+ From ! {block_reply,{error,timeout},Ref},
+ S#state{admin_state = unblocked,
+ blocker_ref = undefined, blocking_tmr = undefined};
+
+handle_block_timeout1(S,disturbing,{_,From,Ref}) ->
+ [exit(Pid,blocked) || Pid <- S#state.connections],
+
+ From ! {block_reply,ok,Ref},
+ S#state{admin_state = blocked, connections = [],
+ blocker_ref = undefined, blocking_tmr = undefined};
+
+handle_block_timeout1(S,Method,{_,From,Ref}) ->
+ 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) ->
+ 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) ->
+ 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,
+ stop_block_tmr(Tmr),
+ S#state{admin_state = unblocked,
+ blocker_ref = undefined, blocking_tmr = undefined}.
+
+
+
+%% -------------------------------------------------------------------------
+%% handle_reload
+%%
+%%
+%%
+%%
+handle_reload(undefined, #state{config_file = undefined} = State) ->
+ {continue, {error, undefined_config_file}, State};
+handle_reload(undefined, #state{config_file = ConfigFile} = State) ->
+ case load_config(ConfigFile) of
+ {ok, Config} ->
+ do_reload(Config, State);
+ {error, Reason} ->
+ error_logger:error_msg("Bad config file: ~p~n", [Reason]),
+ {continue, {error, Reason}, State}
+ end;
+handle_reload(Config, State) ->
+ do_reload(Config, State).
+
+load_config(ConfigFile) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok, Config} ->
+ httpd_conf:validate_properties(Config);
+ Error ->
+ Error
+ end.
+
+do_reload(Config, #state{config_db = Db} = State) ->
+ case (catch check_constant_values(Db, Config)) of
+ ok ->
+ %% If something goes wrong between the remove
+ %% and the store where fu-ed
+ httpd_conf:remove_all(Db),
+ case httpd_conf:store(Config) of
+ {ok, NewConfigDB} ->
+ {continue, ok, State#state{config_db = NewConfigDB}};
+ Error ->
+ {stop, Error, State}
+ end;
+ Error ->
+ {continue, Error, State}
+ end.
+
+check_constant_values(Db, Config) ->
+ %% Check port number
+ Port = httpd_util:lookup(Db,port),
+ case proplists:get_value(port,Config) of %% MUST be equal
+ Port ->
+ ok;
+ OtherPort ->
+ throw({error,{port_number_changed,Port,OtherPort}})
+ end,
+
+ %% Check bind address
+ Addr = httpd_util:lookup(Db,bind_address),
+ case proplists:get_value(bind_address, Config) of %% MUST be equal
+ Addr ->
+ ok;
+ OtherAddr ->
+ throw({error,{addr_changed,Addr,OtherAddr}})
+ end,
+
+ %% Check socket type
+ SockType = httpd_util:lookup(Db, socket_type),
+ case proplists:get_value(socket_type, Config) of %% MUST be equal
+ SockType ->
+ ok;
+ OtherSockType ->
+ throw({error,{sock_type_changed,SockType,OtherSockType}})
+ end,
+ 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 is_pid(Pid) ->
+ case (catch erlang:monitor(process,Pid)) of
+ {'EXIT', _Reason} ->
+ undefined;
+ MonitorRef ->
+ MonitorRef
+ 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().
+
+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).
+
+%%
+call(ServerRef,Request) ->
+ gen_server:call(ServerRef,Request).
+
+cast(ServerRef,Message) ->
+ gen_server:cast(ServerRef,Message).
+
diff --git a/lib/inets/src/http_server/httpd_misc_sup.erl b/lib/inets/src/http_server/httpd_misc_sup.erl
new file mode 100644
index 0000000000..fd7c28bd7d
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_misc_sup.erl
@@ -0,0 +1,91 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The supervisor for auth and sec processes in the http server,
+%% hangs under the httpd_instance_sup_<Addr>_<Port> supervisor.
+%%----------------------------------------------------------------------
+
+-module(httpd_misc_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/2, start_auth_server/2, stop_auth_server/2,
+ start_sec_server/2, stop_sec_server/2]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+start_link(Addr, Port) ->
+ SupName = make_name(Addr, Port),
+ supervisor:start_link({local, SupName}, ?MODULE, []).
+
+%%----------------------------------------------------------------------
+%% Function: [start|stop]_[auth|sec]_server/3
+%% Description: Starts a [auth | security] worker (child) process
+%%----------------------------------------------------------------------
+start_auth_server(Addr, Port) ->
+ start_permanent_worker(mod_auth_server, Addr, Port, [gen_server]).
+
+stop_auth_server(Addr, Port) ->
+ stop_permanent_worker(mod_auth_server, Addr, Port).
+
+
+start_sec_server(Addr, Port) ->
+ start_permanent_worker(mod_security_server, Addr, Port, [gen_server]).
+
+stop_sec_server(Addr, Port) ->
+ stop_permanent_worker(mod_security_server, Addr, Port).
+
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+init(_) ->
+ Flags = {one_for_one, 0, 1},
+ Workers = [],
+ {ok, {Flags, Workers}}.
+
+%%%=========================================================================
+%%% Internal functions
+%%%=========================================================================
+start_permanent_worker(Mod, Addr, Port, Modules) ->
+ SupName = make_name(Addr, Port),
+ Spec = {{Mod, Addr, Port},
+ {Mod, start_link, [Addr, Port]},
+ permanent, timer:seconds(1), worker, [Mod] ++ Modules},
+ supervisor:start_child(SupName, Spec).
+
+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/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl
new file mode 100644
index 0000000000..ad2cc4bda3
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_request.erl
@@ -0,0 +1,379 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(httpd_request).
+
+-include("http_internal.hrl").
+-include("httpd.hrl").
+
+-export([parse/1, whole_body/2, validate/3, update_mod_data/5,
+ body_data/2]).
+
+%% Callback API - used for example if the header/body is received a
+%% little at a time on a socket.
+-export([parse_method/1, parse_uri/1, parse_version/1, parse_headers/1,
+ whole_body/1]).
+
+%%%=========================================================================
+%%% Internal application API
+%%%=========================================================================
+parse([Bin, MaxSizes]) ->
+ parse_method(Bin, [], MaxSizes, []).
+
+%% Functions that may be returned during the decoding process
+%% if the input data is incompleate.
+parse_method([Bin, Method, MaxSizes, Result]) ->
+ parse_method(Bin, Method, MaxSizes, Result).
+
+parse_uri([Bin, URI, CurrSize, MaxSizes, Result]) ->
+ parse_uri(Bin, URI, CurrSize, MaxSizes, Result).
+
+parse_version([Bin, Rest, Version, MaxSizes, Result]) ->
+ parse_version(<<Rest/binary, Bin/binary>>, Version, MaxSizes,
+ Result).
+
+parse_headers([Bin, Rest, Header, Headers, CurrSize, MaxSizes, Result]) ->
+ parse_headers(<<Rest/binary, Bin/binary>>,
+ Header, Headers, CurrSize, MaxSizes, Result).
+
+whole_body([Bin, Body, Length]) ->
+ whole_body(<<Body/binary, Bin/binary>>, Length).
+
+
+%% Separate the body for this request from a possible piplined new
+%% request and convert the body data to "string" format.
+body_data(Headers, Body) ->
+ ContentLength = list_to_integer(Headers#http_request_h.'content-length'),
+ case size(Body) - ContentLength of
+ 0 ->
+ {binary_to_list(Body), <<>>};
+ _ ->
+ <<BodyThisReq:ContentLength/binary, Next/binary>> = Body,
+ {binary_to_list(BodyThisReq), Next}
+ end.
+
+%%-------------------------------------------------------------------------
+%% validate(Method, Uri, Version) -> ok | {error, {bad_request, Reason} |
+%% {error, {not_supported, {Method, Uri, Version}}
+%% Method = "HEAD" | "GET" | "POST" | "TRACE"
+%% Uri = uri()
+%% Version = "HTTP/N.M"
+%% Description: Checks that HTTP-request-line is valid.
+%%-------------------------------------------------------------------------
+validate("HEAD", Uri, "HTTP/1." ++ _N) ->
+ validate_uri(Uri);
+validate("GET", Uri, []) -> %% Simple HTTP/0.9
+ validate_uri(Uri);
+validate("GET", Uri, "HTTP/0.9") ->
+ validate_uri(Uri);
+validate("GET", Uri, "HTTP/1." ++ _N) ->
+ validate_uri(Uri);
+validate("POST", Uri, "HTTP/1." ++ _N) ->
+ validate_uri(Uri);
+validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 ->
+ validate_uri(Uri);
+validate(Method, Uri, Version) ->
+ {error, {not_supported, {Method, Uri, Version}}}.
+
+%%----------------------------------------------------------------------
+%% The request is passed through the server as a record of type mod
+%% create it.
+%% ----------------------------------------------------------------------
+update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)->
+ ParsedHeaders = tagup_header(Headers),
+ PersistentConn = get_persistens(HTTPVersion, ParsedHeaders,
+ ModData#mod.config_db),
+ {ok, ModData#mod{data = [],
+ method = Method,
+ absolute_uri = format_absolute_uri(RequestURI,
+ ParsedHeaders),
+ request_uri = format_request_uri(RequestURI),
+ http_version = HTTPVersion,
+ request_line = Method ++ " " ++ RequestURI ++
+ " " ++ HTTPVersion,
+ parsed_header = ParsedHeaders,
+ connection = PersistentConn}}.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+parse_method(<<>>, Method, MaxSizes, Result) ->
+ {?MODULE, parse_method, [Method, MaxSizes, Result]};
+parse_method(<<?SP, Rest/binary>>, Method, MaxSizes, Result) ->
+ parse_uri(Rest, [], 0, MaxSizes,
+ [string:strip(lists:reverse(Method)) | Result]);
+parse_method(<<Octet, Rest/binary>>, Method, MaxSizes, Result) ->
+ parse_method(Rest, [Octet | Method], MaxSizes, Result).
+
+parse_uri(_, _, CurrSize, {MaxURI, _}, _) when CurrSize > MaxURI,
+ MaxURI =/= nolimit ->
+ %% We do not know the version of the client as it comes after the
+ %% uri send the lowest version in the response so that the client
+ %% will be able to handle it.
+ HttpVersion = "HTTP/0.9",
+ {error, {uri_too_long, MaxURI}, HttpVersion};
+parse_uri(<<>>, URI, CurrSize, MaxSizes, Result) ->
+ {?MODULE, parse_uri, [URI, CurrSize, MaxSizes, Result]};
+parse_uri(<<?SP, Rest/binary>>, URI, _, MaxSizes, Result) ->
+ parse_version(Rest, [], MaxSizes,
+ [string:strip(lists:reverse(URI)) | Result]);
+%% Can happen if it is a simple HTTP/0.9 request e.i "GET /\r\n\r\n"
+parse_uri(<<?CR, _Rest/binary>> = Data, URI, _,MaxSizes, Result) ->
+ parse_version(Data, [], MaxSizes,
+ [string:strip(lists:reverse(URI)) | Result]);
+parse_uri(<<Octet, Rest/binary>>, URI, CurrSize, MaxSizes, Result) ->
+ parse_uri(Rest, [Octet | URI], CurrSize + 1, MaxSizes, Result).
+
+parse_version(<<>>, Version, MaxSizes, Result) ->
+ {?MODULE, parse_version, [<<>>, Version, MaxSizes, Result]};
+parse_version(<<?LF, Rest/binary>>, Version, MaxSizes, Result) ->
+ %% If ?CR is is missing RFC2616 section-19.3
+ parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result);
+parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result) ->
+ parse_headers(Rest, [], [], 0, MaxSizes,
+ [string:strip(lists:reverse(Version)) | Result]);
+parse_version(<<?CR>> = Data, Version, MaxSizes, Result) ->
+ {?MODULE, parse_version, [Data, Version, MaxSizes, Result]};
+parse_version(<<Octet, Rest/binary>>, Version, MaxSizes, Result) ->
+ parse_version(Rest, [Octet | Version], MaxSizes, Result).
+
+parse_headers(_, _, _, CurrSize, {_, MaxHeaderSize}, Result)
+ when CurrSize > MaxHeaderSize, MaxHeaderSize =/= nolimit ->
+ HttpVersion = lists:nth(3, lists:reverse(Result)),
+ {error, {header_too_long, MaxHeaderSize}, HttpVersion};
+
+parse_headers(<<>>, Header, Headers, CurrSize, MaxSizes, Result) ->
+ {?MODULE, parse_headers, [<<>>, Header, Headers, CurrSize,
+ MaxSizes, Result]};
+parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) ->
+ %% If ?CR is is missing RFC2616 section-19.3
+ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize,
+ MaxSizes, Result);
+
+parse_headers(<<?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) ->
+ %% If ?CR is is missing RFC2616 section-19.3
+ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize,
+ MaxSizes, Result);
+
+parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, Result) ->
+ NewResult = list_to_tuple(lists:reverse([Body, {#http_request_h{}, []} |
+ Result])),
+ {ok, NewResult};
+parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _,
+ _, Result) ->
+ HTTPHeaders = [lists:reverse(Header) | Headers],
+ RequestHeaderRcord =
+ http_request:headers(HTTPHeaders, #http_request_h{}),
+ NewResult =
+ list_to_tuple(lists:reverse([Body, {RequestHeaderRcord,
+ HTTPHeaders} | Result])),
+ {ok, NewResult};
+
+parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, CurrSize,
+ MaxSizes, Result) ->
+ {?MODULE, parse_headers, [Data, Header, Headers, CurrSize,
+ MaxSizes, Result]};
+parse_headers(<<?LF>>, [], [], CurrSize, MaxSizes, Result) ->
+ %% If ?CR is is missing RFC2616 section-19.3
+ parse_headers(<<?CR,?LF>>, [], [], CurrSize, MaxSizes, Result);
+
+%% There where no headers, which is unlikely to happen.
+parse_headers(<<?CR,?LF>>, [], [], _, _, Result) ->
+ NewResult = list_to_tuple(lists:reverse([<<>>, {#http_request_h{}, []} |
+ Result])),
+ {ok, NewResult};
+
+parse_headers(<<?LF>>, Header, Headers, CurrSize,
+ MaxSizes, Result) ->
+ %% If ?CR is is missing RFC2616 section-19.3
+ parse_headers(<<?CR,?LF>>, Header, Headers, CurrSize, MaxSizes, Result);
+
+parse_headers(<<?CR,?LF>> = Data, Header, Headers, CurrSize,
+ MaxSizes, Result) ->
+ {?MODULE, parse_headers, [Data, Header, Headers, CurrSize,
+ MaxSizes, Result]};
+parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, CurrSize,
+ MaxSizes, Result) ->
+ %% If ?CR is is missing RFC2616 section-19.3
+ parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize,
+ MaxSizes, Result);
+parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize,
+ MaxSizes, Result) ->
+ parse_headers(Rest, [Octet], [lists:reverse(Header) | Headers],
+ CurrSize + 1, MaxSizes, Result);
+
+parse_headers(<<?CR>> = Data, Header, Headers, CurrSize,
+ MaxSizes, Result) ->
+ {?MODULE, parse_headers, [Data, Header, Headers, CurrSize,
+ MaxSizes, Result]};
+parse_headers(<<?LF>>, Header, Headers, CurrSize,
+ MaxSizes, Result) ->
+ %% If ?CR is is missing RFC2616 section-19.3
+ parse_headers(<<?CR, ?LF>>, Header, Headers, CurrSize,
+ MaxSizes, Result);
+
+parse_headers(<<Octet, Rest/binary>>, Header, Headers,
+ CurrSize, MaxSizes, Result) ->
+ parse_headers(Rest, [Octet | Header], Headers, CurrSize + 1,
+ MaxSizes, Result).
+
+whole_body(Body, Length) ->
+ case size(Body) of
+ N when N < Length, Length > 0 ->
+ {?MODULE, whole_body, [Body, Length]};
+ N when N >= Length, Length >= 0 ->
+ %% When a client uses pipelining trailing data
+ %% may be part of the next request!
+ %% Trailing data will be separated from
+ %% the actual body in body_data/2.
+ {ok, Body}
+ end.
+
+%% Prevent people from trying to access directories/files
+%% relative to the ServerRoot.
+validate_uri(RequestURI) ->
+ UriNoQueryNoHex =
+ case string:str(RequestURI, "?") of
+ 0 ->
+ (catch httpd_util:decode_hex(RequestURI));
+ Ndx ->
+ (catch httpd_util:decode_hex(string:left(RequestURI, Ndx)))
+ end,
+ case UriNoQueryNoHex of
+ {'EXIT',_Reason} ->
+ {error, {bad_request, {malformed_syntax, RequestURI}}};
+ _ ->
+ Path = format_request_uri(UriNoQueryNoHex),
+ Path2=[X||X<-string:tokens(Path, "/"),X=/="."], %% OTP-5938
+ validate_path( Path2,0, RequestURI)
+ end.
+
+validate_path([], _, _) ->
+ ok;
+validate_path([".." | _], 0, RequestURI) ->
+ {error, {bad_request, {forbidden, RequestURI}}};
+validate_path([".." | Rest], N, RequestURI) ->
+ validate_path(Rest, N - 1, RequestURI);
+validate_path([_ | Rest], N, RequestURI) ->
+ validate_path(Rest, N + 1, RequestURI).
+
+%%----------------------------------------------------------------------
+%% 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.
+%%----------------------------------------------------------------------
+format_request_uri("*")->
+ "*";
+format_request_uri("http://" ++ ServerAndPath) ->
+ remove_server(ServerAndPath);
+
+format_request_uri("HTTP://" ++ ServerAndPath) ->
+ remove_server(ServerAndPath);
+
+format_request_uri(ABSPath) ->
+ ABSPath.
+
+remove_server([]) ->
+ "/";
+remove_server([$\/|Url])->
+ case Url of
+ []->
+ "/";
+ _->
+ [$\/|Url]
+ end;
+remove_server([_|Url]) ->
+ remove_server(Url).
+
+format_absolute_uri("http://"++ Uri, _)->
+ "HTTP://" ++ Uri;
+
+format_absolute_uri(OrigUri = "HTTP://" ++ _, _)->
+ OrigUri;
+
+format_absolute_uri(Uri,ParsedHeader)->
+ case proplists:get_value("host", ParsedHeader) of
+ undefined ->
+ nohost;
+ Host ->
+ Host++Uri
+ end.
+
+get_persistens(HTTPVersion,ParsedHeader,ConfigDB)->
+ case httpd_util:lookup(ConfigDB, keep_alive, true) of
+ true->
+ case HTTPVersion of
+ %%If it is version prio to 1.1 kill the conneciton
+ "HTTP/1." ++ NList ->
+ case proplists:get_value("connection", ParsedHeader,
+ "keep-alive") of
+ %%if the connection is not 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 hd(NList) >= 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.
+
+
+%%----------------------------------------------------------------------
+%% 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) ->
+ {http_util:to_lower(lists:reverse(Tag)), ""};
+tag([$:|Rest], Tag) ->
+ {http_util:to_lower(lists:reverse(Tag)), string:strip(Rest)};
+tag([Chr|Rest], Tag) ->
+ tag(Rest, [Chr|Tag]).
+
diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl
new file mode 100644
index 0000000000..fa832cba3f
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_request_handler.erl
@@ -0,0 +1,611 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% Description: Implements a request handler process for the HTTP server.
+%%
+
+-module(httpd_request_handler).
+
+-behaviour(gen_server).
+
+%% Application internal API
+-export([start/2, start/3, socket_ownership_transfered/3]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-include("httpd.hrl").
+-include("http_internal.hrl").
+-include("httpd_internal.hrl").
+
+-record(state, {mod, %% #mod{}
+ manager, %% pid()
+ status, %% accept | busy | blocked
+ mfa, %% {Module, Function, Args}
+ max_keep_alive_request = infinity, %% integer() | infinity
+ response_sent = false, %% true | false
+ timeout, %% infinity | integer() > 0
+ timer, %% ref() - Request timer
+ headers, %% #http_request_h{}
+ body %% binary()
+ }).
+
+%%====================================================================
+%% Application internal API
+%%====================================================================
+%%--------------------------------------------------------------------
+%% Function: start() -> {ok, Pid} | ignore | {error,Error}
+%% Description: Starts a httpd-request handler process. Intended to be
+%% called by the httpd acceptor process.
+%%--------------------------------------------------------------------
+start(Manager, ConfigDB) ->
+ start(Manager, ConfigDB, 15000).
+start(Manager, ConfigDB, AcceptTimeout) ->
+ proc_lib:start(?MODULE, init, [[Manager, ConfigDB,AcceptTimeout]]).
+
+
+%%--------------------------------------------------------------------
+%% socket_ownership_transfered(Pid, SocketType, Socket) -> void()
+%%
+%% Pid = pid()
+%% SocketType = ip_comm | ssl
+%% Socket = socket()
+%%
+%% Description: Send a message to the request handler process
+%% confirming that the socket ownership has now sucssesfully been
+%% transfered to it. Intended to be called by the httpd acceptor
+%% process.
+%%--------------------------------------------------------------------
+socket_ownership_transfered(Pid, SocketType, Socket) ->
+ Pid ! {socket_ownership_transfered, SocketType, Socket}.
+
+%%--------------------------------------------------------------------
+%% Function: init(Args) -> _
+%%
+%% Description: Initiates the server. Obs special init that uses
+%% gen_server:enter_loop/3. This is used instead of the normal
+%% gen_server callback init, as a more complex init than the
+%% gen_server provides is needed.
+%%--------------------------------------------------------------------
+init([Manager, ConfigDB, AcceptTimeout]) ->
+ ?hdrd("initiate",
+ [{manager, Manager}, {cdb, ConfigDB}, {timeout, AcceptTimeout}]),
+ %% Make sure this process terminates if the httpd manager process
+ %% should die!
+ link(Manager),
+ %% At this point the function httpd_request_handler:start/2 will return.
+ proc_lib:init_ack({ok, self()}),
+
+ {SocketType, Socket} = await_socket_ownership_transfer(AcceptTimeout),
+ ?hdrd("socket ownership transfered",
+ [{socket_type, SocketType}, {socket, Socket}]),
+
+ TimeOut = httpd_util:lookup(ConfigDB, keep_alive_timeout, 150000),
+
+ Then = erlang:now(),
+
+ case http_transport:negotiate(SocketType, Socket, TimeOut) of
+ {error, Error} ->
+ exit(Error); %% Can be 'normal'.
+ ok ->
+ ?hdrt("negotiated", []),
+ NewTimeout = TimeOut - timer:now_diff(now(),Then) div 1000,
+ continue_init(Manager, ConfigDB, SocketType, Socket, NewTimeout)
+ end.
+
+continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) ->
+ ?hdrt("continue init", [{timeout, TimeOut}]),
+ Resolve = http_transport:resolve(),
+
+ Peername = httpd_socket:peername(SocketType, Socket),
+ InitData = #init_data{peername = Peername, resolve = Resolve},
+ Mod = #mod{config_db = ConfigDB,
+ socket_type = SocketType,
+ socket = Socket,
+ init_data = InitData},
+
+ MaxHeaderSize = httpd_util:lookup(ConfigDB, max_header_size,
+ ?HTTP_MAX_HEADER_SIZE),
+ MaxURISize = httpd_util:lookup(ConfigDB, max_uri_size,
+ ?HTTP_MAX_URI_SIZE),
+ NrOfRequest = httpd_util:lookup(ConfigDB,
+ max_keep_alive_request, infinity),
+
+ {_, Status} = httpd_manager:new_connection(Manager),
+
+ MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]},
+
+ State = #state{mod = Mod,
+ manager = Manager,
+ status = Status,
+ timeout = TimeOut,
+ max_keep_alive_request = NrOfRequest,
+ mfa = MFA},
+
+ ?hdrt("activate request timeout", []),
+ NewState = activate_request_timeout(State),
+
+ ?hdrt("update socket options", []),
+ http_transport:setopts(SocketType, Socket, [binary,{packet, 0},
+ {active, once}]),
+ ?hdrt("init done", []),
+ gen_server:enter_loop(?MODULE, [], NewState).
+
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% handle_call(Request, From, State) -> {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} |
+%% {stop, Reason, State}
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call(Request, From, State) ->
+ {stop, {call_api_violation, Request, From}, State}.
+
+%%--------------------------------------------------------------------
+%% handle_cast(Msg, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(Msg, State) ->
+ {reply, {cast_api_violation, Msg}, State}.
+
+%%--------------------------------------------------------------------
+%% handle_info(Info, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info({Proto, Socket, Data}, State =
+ #state{mfa = {Module, Function, Args} = MFA,
+ mod = #mod{socket_type = SockType,
+ socket = Socket} = ModData} = State)
+ when (((Proto =:= tcp) orelse
+ (Proto =:= ssl) orelse
+ (Proto =:= dummy)) andalso is_binary(Data)) ->
+ ?hdrd("received data",
+ [{data, Data}, {proto, Proto},
+ {socket, Socket}, {socket_type, SockType}, {mfa, MFA}]),
+ case Module:Function([Data | Args]) of
+ {ok, Result} ->
+ ?hdrd("data processed", [{result, Result}]),
+ NewState = cancel_request_timeout(State),
+ handle_http_msg(Result, NewState);
+ {error, {uri_too_long, MaxSize}, Version} ->
+ ?hdrv("uri too long", [{max_size, MaxSize}, {version, Version}]),
+ NewModData = ModData#mod{http_version = Version},
+ httpd_response:send_status(NewModData, 414, "URI too long"),
+ Reason = io_lib:format("Uri too long, max size is ~p~n",
+ [MaxSize]),
+ error_log(Reason, NewModData),
+ {stop, normal, State#state{response_sent = true,
+ mod = NewModData}};
+ {error, {header_too_long, MaxSize}, Version} ->
+ ?hdrv("header too long", [{max_size, MaxSize}, {version, Version}]),
+ NewModData = ModData#mod{http_version = Version},
+ httpd_response:send_status(NewModData, 413, "Header too long"),
+ Reason = io_lib:format("Header too long, max size is ~p~n",
+ [MaxSize]),
+ error_log(Reason, NewModData),
+ {stop, normal, State#state{response_sent = true,
+ mod = NewModData}};
+ NewMFA ->
+ ?hdrd("data processed - reactivate socket", [{new_mfa, NewMFA}]),
+ http_transport:setopts(SockType, Socket, [{active, once}]),
+ {noreply, State#state{mfa = NewMFA}}
+ end;
+
+%% Error cases
+handle_info({tcp_closed, _}, State) ->
+ {stop, normal, State};
+handle_info({ssl_closed, _}, State) ->
+ {stop, normal, State};
+handle_info({tcp_error, _, _} = Reason, State) ->
+ {stop, Reason, State};
+handle_info({ssl_error, _, _} = Reason, State) ->
+ {stop, Reason, State};
+
+%% Timeouts
+handle_info(timeout, #state{mod = ModData, mfa = {_, parse, _}} = State) ->
+ error_log("No request received on keep-alive connection"
+ "before server side timeout", ModData),
+ %% No response should be sent!
+ {stop, normal, State#state{response_sent = true}};
+handle_info(timeout, #state{mod = ModData} = State) ->
+ httpd_response:send_status(ModData, 408, "Request timeout"),
+ error_log("The client did not send the whole request before the"
+ "server side timeout", ModData),
+ {stop, normal, State#state{response_sent = true}};
+
+%% Default case
+handle_info(Info, #state{mod = ModData} = State) ->
+ Error = lists:flatten(
+ io_lib:format("Unexpected message received: ~n~p~n", [Info])),
+ error_log(Error, ModData),
+ {noreply, State}.
+
+
+%%--------------------------------------------------------------------
+%% terminate(Reason, State) -> void()
+%%
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(normal, State) ->
+ do_terminate(State);
+terminate(Reason, #state{response_sent = false, mod = ModData} = State) ->
+ httpd_response:send_status(ModData, 500, none),
+ error_log(httpd_util:reason_phrase(500), ModData),
+ terminate(Reason, State#state{response_sent = true, mod = ModData});
+terminate(_, State) ->
+ do_terminate(State).
+
+do_terminate(#state{mod = ModData, manager = Manager} = State) ->
+ catch httpd_manager:done_connection(Manager),
+ cancel_request_timeout(State),
+ httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket).
+
+%%--------------------------------------------------------------------
+%% code_change(OldVsn, State, Extra) -> {ok, NewState}
+%%
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+await_socket_ownership_transfer(AcceptTimeout) ->
+ receive
+ {socket_ownership_transfered, SocketType, Socket} ->
+ {SocketType, Socket}
+ after AcceptTimeout ->
+ exit(accept_socket_timeout)
+ end.
+
+handle_http_msg({_, _, Version, {_, _}, _},
+ #state{status = busy, mod = ModData} = State) ->
+ ?hdrt("handle http msg when manager busy", [{mod, ModData}]),
+ handle_manager_busy(State#state{mod =
+ ModData#mod{http_version = Version}}),
+ {stop, normal, State};
+
+handle_http_msg({_, _, Version, {_, _}, _},
+ #state{status = blocked, mod = ModData} = State) ->
+ ?hdrt("handle http msg when manager blocket", [{mod, ModData}]),
+ handle_manager_blocked(State#state{mod =
+ ModData#mod{http_version = Version}}),
+ {stop, normal, State};
+
+handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body},
+ #state{status = accept, mod = ModData} = State) ->
+ ?hdrt("handle http msg when manager accepting",
+ [{method, Method}, {mod, ModData}]),
+ case httpd_request:validate(Method, Uri, Version) of
+ ok ->
+ ?hdrt("request validated", []),
+ {ok, NewModData} =
+ httpd_request:update_mod_data(ModData, Method, Uri,
+ Version, Headers),
+
+ ?hdrt("new mod data", [{mod, NewModData}]),
+ case is_host_specified_if_required(NewModData#mod.absolute_uri,
+ RecordHeaders, Version) of
+ true ->
+ handle_body(State#state{headers = RecordHeaders,
+ body = Body,
+ mod = NewModData});
+ false ->
+ httpd_response:send_status(ModData#mod{http_version =
+ Version},
+ 400, none),
+ {stop, normal, State#state{response_sent = true}}
+ end;
+ {error, {not_supported, What}} ->
+ ?hdrd("validation failed: not supported", [{what, What}]),
+ httpd_response:send_status(ModData#mod{http_version = Version},
+ 501, {Method, Uri, Version}),
+ Reason = io_lib:format("Not supported: ~p~n", [What]),
+ error_log(Reason, ModData),
+ {stop, normal, State#state{response_sent = true}};
+ {error, {bad_request, {forbidden, URI}}} ->
+ ?hdrd("validation failed: bad request - forbidden",
+ [{uri, URI}]),
+ httpd_response:send_status(ModData#mod{http_version = Version},
+ 403, URI),
+ Reason = io_lib:format("Forbidden URI: ~p~n", [URI]),
+ error_log(Reason, ModData),
+ {stop, normal, State#state{response_sent = true}};
+ {error,{bad_request, {malformed_syntax, URI}}} ->
+ ?hdrd("validation failed: bad request - malformed syntax",
+ [{uri, URI}]),
+ httpd_response:send_status(ModData#mod{http_version = Version},
+ 400, URI),
+ Reason = io_lib:format("Malformed syntax in URI: ~p~n", [URI]),
+ error_log(Reason, ModData),
+ {stop, normal, State#state{response_sent = true}}
+ end;
+handle_http_msg({ChunkedHeaders, Body},
+ State = #state{headers = Headers}) ->
+ ?hdrt("handle http msg",
+ [{chunked_headers, ChunkedHeaders}, {body, Body}]),
+ NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders),
+ handle_response(State#state{headers = NewHeaders, body = Body});
+handle_http_msg(Body, State) ->
+ ?hdrt("handle http msg", [{body, Body}]),
+ handle_response(State#state{body = Body}).
+
+handle_manager_busy(#state{mod = #mod{config_db = ConfigDB}} = State) ->
+ MaxClients = httpd_util:lookup(ConfigDB, max_clients, 150),
+ Reason = io_lib:format("heavy load (>~w processes)", [MaxClients]),
+ reject_connection(State, lists:flatten(Reason)).
+
+handle_manager_blocked(State) ->
+ Reason = "Server maintenance performed, try again later",
+ reject_connection(State, Reason).
+
+reject_connection(#state{mod = ModData} = State, Reason) ->
+ httpd_response:send_status(ModData, 503, Reason),
+ {stop, normal, State#state{response_sent = true}}.
+
+is_host_specified_if_required(nohost, #http_request_h{host = undefined},
+ "HTTP/1.1") ->
+ false;
+is_host_specified_if_required(_, _, _) ->
+ true.
+
+handle_body(#state{mod = #mod{config_db = ConfigDB}} = State) ->
+ ?hdrt("handle body", []),
+ MaxHeaderSize =
+ httpd_util:lookup(ConfigDB, max_header_size, ?HTTP_MAX_HEADER_SIZE),
+ MaxBodySize = httpd_util:lookup(ConfigDB, max_body_size, nolimit),
+
+ case handle_expect(State, MaxBodySize) of
+ ok ->
+ handle_body(State, MaxHeaderSize, MaxBodySize);
+ Other ->
+ Other
+
+ end.
+
+handle_body(#state{headers = Headers, body = Body, mod = ModData} = State,
+ MaxHeaderSize, MaxBodySize) ->
+ ?hdrt("handle body", [{headers, Headers}, {body, Body}]),
+ case Headers#http_request_h.'transfer-encoding' of
+ "chunked" ->
+ ?hdrt("chunked - attempt decode", []),
+ case http_chunk:decode(Body, MaxBodySize, MaxHeaderSize) of
+ {Module, Function, Args} ->
+ ?hdrt("chunk decoded",
+ [{module, Module},
+ {function, Function},
+ {args, Args}]),
+ http_transport:setopts(ModData#mod.socket_type,
+ ModData#mod.socket,
+ [{active, once}]),
+ {noreply, State#state{mfa =
+ {Module, Function, Args}}};
+ {ok, {ChunkedHeaders, NewBody}} ->
+ ?hdrt("chunk decoded",
+ [{chunked_headers, ChunkedHeaders},
+ {new_body, NewBody}]),
+ NewHeaders =
+ http_chunk:handle_headers(Headers, ChunkedHeaders),
+ ?hdrt("chunked - headers handled",
+ [{new_headers, NewHeaders}]),
+ handle_response(State#state{headers = NewHeaders,
+ body = NewBody})
+ end;
+ Encoding when is_list(Encoding) ->
+ ?hdrt("not chunked - encoding", [{encoding, Encoding}]),
+ httpd_response:send_status(ModData, 501,
+ "Unknown Transfer-Encoding"),
+ Reason = io_lib:format("Unknown Transfer-Encoding: ~p~n",
+ [Encoding]),
+ error_log(Reason, ModData),
+ {stop, normal, State#state{response_sent = true}};
+ _ ->
+ ?hdrt("not chunked", []),
+ Length =
+ list_to_integer(Headers#http_request_h.'content-length'),
+ case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of
+ true ->
+ case httpd_request:whole_body(Body, Length) of
+ {Module, Function, Args} ->
+ ?hdrt("whole body",
+ [{module, Module},
+ {function, Function},
+ {args, Args}]),
+ http_transport:setopts(ModData#mod.socket_type,
+ ModData#mod.socket,
+ [{active, once}]),
+ {noreply, State#state{mfa =
+ {Module, Function, Args}}};
+
+ {ok, NewBody} ->
+ ?hdrt("whole body",
+ [{new_body, NewBody}]),
+ handle_response(
+ State#state{headers = Headers,
+ body = NewBody})
+ end;
+ false ->
+ ?hdrd("body too long",
+ [{length, Length}, {max_body_size, MaxBodySize}]),
+ httpd_response:send_status(ModData, 413, "Body too long"),
+ error_log("Body too long", ModData),
+ {stop, normal, State#state{response_sent = true}}
+ end
+ end.
+
+handle_expect(#state{headers = Headers, mod =
+ #mod{config_db = ConfigDB} = ModData} = State,
+ MaxBodySize) ->
+ Length = Headers#http_request_h.'content-length',
+ case expect(Headers, ModData#mod.http_version, ConfigDB) of
+ continue when (MaxBodySize > Length) orelse (MaxBodySize =:= nolimit) ->
+ httpd_response:send_status(ModData, 100, ""),
+ ok;
+ continue when MaxBodySize < Length ->
+ httpd_response:send_status(ModData, 413, "Body too long"),
+ error_log("Body too long", ModData),
+ {stop, normal, State#state{response_sent = true}};
+ {break, Value} ->
+ httpd_response:send_status(ModData, 417,
+ "Unexpected expect value"),
+ Reason = io_lib:format("Unexpected expect value: ~p~n", [Value]),
+ error_log(Reason, ModData),
+ {stop, normal, State#state{response_sent = true}};
+ no_expect_header ->
+ ok;
+ http_1_0_expect_header ->
+ httpd_response:send_status(ModData, 400,
+ "Only HTTP/1.1 Clients "
+ "may use the Expect Header"),
+ error_log("Client with lower version than 1.1 tried to send"
+ "an expect header", ModData),
+ {stop, normal, State#state{response_sent = true}}
+ end.
+
+expect(Headers, "HTTP/1.1", _) ->
+ case Headers#http_request_h.expect of
+ "100-continue" ->
+ continue;
+ undefined ->
+ no_expect_header;
+ Other ->
+ {break, Other}
+ end;
+expect(Headers, _, ConfigDB) ->
+ case Headers#http_request_h.expect of
+ undefined ->
+ no_expect_header;
+ _ ->
+ case httpd_util:lookup(ConfigDB, expect, continue) of
+ continue->
+ no_expect_header;
+ _ ->
+ http_1_0_expect_header
+ end
+ end.
+
+handle_response(#state{body = Body,
+ mod = ModData,
+ headers = Headers,
+ max_keep_alive_request = Max} = State) when Max > 0 ->
+ ?hdrt("handle response",
+ [{body, Body}, {mod, ModData}, {headers, Headers}, {max, Max}]),
+ {NewBody, Data} = httpd_request:body_data(Headers, Body),
+ ok = httpd_response:generate_and_send_response(
+ ModData#mod{entity_body = NewBody}),
+ handle_next_request(State#state{response_sent = true}, Data);
+
+handle_response(#state{body = Body,
+ headers = Headers,
+ mod = ModData} = State) ->
+ ?hdrt("handle response",
+ [{body, Body}, {mod, ModData}, {headers, Headers}]),
+ {NewBody, _} = httpd_request:body_data(Headers, Body),
+ ok = httpd_response:generate_and_send_response(
+ ModData#mod{entity_body = NewBody}),
+ {stop, normal, State#state{response_sent = true}}.
+
+handle_next_request(#state{mod = #mod{connection = true} = ModData,
+ max_keep_alive_request = Max} = State, Data) ->
+ ?hdrt("handle next request", [{max, Max}]),
+ NewModData = #mod{socket_type = ModData#mod.socket_type,
+ socket = ModData#mod.socket,
+ config_db = ModData#mod.config_db,
+ init_data = ModData#mod.init_data},
+ MaxHeaderSize =
+ httpd_util:lookup(ModData#mod.config_db,
+ max_header_size, ?HTTP_MAX_HEADER_SIZE),
+ MaxURISize = httpd_util:lookup(ModData#mod.config_db, max_uri_size,
+ ?HTTP_MAX_URI_SIZE),
+ TmpState = State#state{mod = NewModData,
+ mfa = {httpd_request, parse, [{MaxURISize,
+ MaxHeaderSize}]},
+ max_keep_alive_request = decrease(Max),
+ headers = undefined,
+ body = undefined,
+ response_sent = false},
+
+ NewState = activate_request_timeout(TmpState),
+
+ case Data of
+ <<>> ->
+ http_transport:setopts(ModData#mod.socket_type,
+ ModData#mod.socket, [{active, once}]),
+ {noreply, NewState};
+ _ ->
+ handle_info({dummy, ModData#mod.socket, Data}, NewState)
+ end;
+
+handle_next_request(State, _) ->
+ ?hdrt("handle next request - stop", []),
+ {stop, normal, State}.
+
+activate_request_timeout(#state{timeout = Time} = State) ->
+ ?hdrt("activate request timeout", [{time, Time}]),
+ Ref = erlang:send_after(Time, self(), timeout),
+ State#state{timer = Ref}.
+
+cancel_request_timeout(#state{timer = undefined} = State) ->
+ State;
+cancel_request_timeout(#state{timer = Timer} = State) ->
+ erlang:cancel_timer(Timer),
+ receive
+ timeout ->
+ ok
+ after 0 ->
+ ok
+ end,
+ State#state{timer = undefined}.
+
+decrease(N) when is_integer(N) ->
+ N-1;
+decrease(N) ->
+ N.
+
+error_log(ReasonString, Info) ->
+ Error = lists:flatten(
+ io_lib:format("Error reading request:~s",[ReasonString])),
+ error_log(mod_log, Info, Error),
+ error_log(mod_disk_log, Info, Error).
+
+error_log(Mod, #mod{config_db = ConfigDB} = Info, String) ->
+ Modules = httpd_util:lookup(ConfigDB, modules,
+ [mod_get, mod_head, mod_log]),
+ case lists:member(Mod, Modules) of
+ true ->
+ Mod:error_log(Info, String);
+ _ ->
+ ok
+ end.
diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl
new file mode 100644
index 0000000000..ea9cfbf4f2
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_response.erl
@@ -0,0 +1,407 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_response).
+-export([generate_and_send_response/1, send_status/3, send_header/3,
+ send_body/3, send_chunk/3, send_final_chunk/2, split_header/2,
+ is_disable_chunked_send/1, cache_headers/1]).
+-export([map_status_code/2]).
+
+-include("httpd.hrl").
+-include("http_internal.hrl").
+-include("httpd_internal.hrl").
+
+-define(VMODULE,"RESPONSE").
+
+%% If peername does not exist the client already discarded the
+%% request so we do not need to send a reply.
+generate_and_send_response(#mod{init_data =
+ #init_data{peername = {_,"unknown"}}}) ->
+ ok;
+generate_and_send_response(#mod{config_db = ConfigDB} = ModData) ->
+ Modules = httpd_util:lookup(ConfigDB,modules,
+ [mod_get, mod_head, mod_log]),
+ case traverse_modules(ModData, Modules) of
+ done ->
+ ok;
+ {proceed, Data} ->
+ case proplists:get_value(status, Data) of
+ {StatusCode, PhraseArgs, _Reason} ->
+ send_status(ModData, StatusCode, PhraseArgs),
+ ok;
+ undefined ->
+ case proplists:get_value(response, Data) of
+ {already_sent, _StatusCode, _Size} ->
+ ok;
+ {response, Header, Body} -> %% New way
+ send_response(ModData, Header, Body),
+ ok;
+ {StatusCode, Response} -> %% Old way
+ send_response_old(ModData, StatusCode, Response),
+ ok;
+ undefined ->
+ send_status(ModData, 500, none),
+ ok
+ end
+ end
+ end.
+
+
+%% traverse_modules
+
+traverse_modules(ModData,[]) ->
+ {proceed,ModData#mod.data};
+traverse_modules(ModData,[Module|Rest]) ->
+ ?hdrd("traverse modules", [{callback_module, Module}]),
+ case (catch apply(Module, do, [ModData])) of
+ {'EXIT', Reason} ->
+ ?hdrd("traverse modules - exit", [{reason, Reason}]),
+ String =
+ lists:flatten(
+ io_lib:format("traverse exit from apply: ~p:do => ~n~p",
+ [Module, Reason])),
+ report_error(mod_log, ModData#mod.config_db, String),
+ report_error(mod_disk_log, ModData#mod.config_db, String),
+ done;
+ done ->
+ ?hdrt("traverse modules - done", []),
+ done;
+ {break, NewData} ->
+ ?hdrt("traverse modules - break", [{new_data, NewData}]),
+ {proceed, NewData};
+ {proceed, NewData} ->
+ ?hdrt("traverse modules - proceed", [{new_data, NewData}]),
+ traverse_modules(ModData#mod{data = NewData}, Rest)
+ end.
+
+%% send_status %%
+
+
+send_status(ModData, 100, _PhraseArgs) ->
+ send_header(ModData, 100, [{content_length, "0"}]);
+
+send_status(#mod{socket_type = SocketType,
+ socket = Socket,
+ config_db = ConfigDB} = ModData, StatusCode, PhraseArgs) ->
+
+ ReasonPhrase = httpd_util:reason_phrase(StatusCode),
+ Message = httpd_util:message(StatusCode, PhraseArgs, ConfigDB),
+ Body = get_body(ReasonPhrase, Message),
+
+ send_header(ModData, StatusCode, [{content_type, "text/html"},
+ {content_length, integer_to_list(length(Body))}]),
+ httpd_socket:deliver(SocketType, Socket, Body).
+
+
+get_body(ReasonPhrase, Message)->
+ "<HTML>
+ <HEAD>
+ <TITLE>"++ReasonPhrase++"</TITLE>
+ </HEAD>
+ <BODY>
+ <H1>"++ReasonPhrase++"</H1>\n"++Message++"\n</BODY>
+ </HTML>\n".
+
+
+send_response(ModData, Header, Body) ->
+ case proplists:get_value(code, Header) of
+ undefined ->
+ %% No status code
+ %% Ooops this must be very bad:
+ %% generate a 404 content not availible
+ send_status(ModData, 404, "The file is not availible");
+ StatusCode ->
+ case send_header(ModData, StatusCode, lists:keydelete(code, 1,
+ Header)) of
+ ok ->
+ send_body(ModData, StatusCode, Body);
+ _ ->
+ done
+ end
+ end.
+
+send_header(#mod{socket_type = Type, socket = Sock,
+ http_version = Ver, connection = Conn} = _ModData,
+ StatusCode, KeyValueTupleHeaders) ->
+ Headers = create_header(lists:map(fun transform/1, KeyValueTupleHeaders)),
+ NewVer = case {Ver, StatusCode} of
+ {[], _} ->
+ %% May be implicit!
+ "HTTP/0.9";
+ {unknown, 408} ->
+ %% This will proably never happen! It means the
+ %% server has timed out the request without
+ %% receiving a version for the request! Send the
+ %% lowest version so to ensure that the client
+ %% will be able to handle it, probably the
+ %% sensible thing to do!
+ "HTTP/0.9";
+ {undefined,_} ->
+ "HTTP/1.0"; %% See rfc2145 2.3 last paragraph
+ _ ->
+ Ver
+ end,
+ NewStatusCode = map_status_code(NewVer, StatusCode),
+ StatusLine = [NewVer, " ", io_lib:write(NewStatusCode), " ",
+ httpd_util:reason_phrase(NewStatusCode), ?CRLF],
+ ConnectionHeader = get_connection(Conn, NewVer),
+ Head = list_to_binary([StatusLine, Headers, ConnectionHeader , ?CRLF]),
+ httpd_socket:deliver(Type, Sock, Head).
+
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 2) andalso (Code > 204) ->
+ 403;
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 3) andalso (Code > 304) ->
+ 403;
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 4) andalso (Code > 404) ->
+ 403;
+map_status_code("HTTP/1.0", Code)
+ when ((Code div 100) =:= 5) andalso (Code > 503) ->
+ 403;
+map_status_code(_, Code) ->
+ Code.
+
+send_body(#mod{socket_type = Type, socket = Socket}, _, nobody) ->
+ httpd_socket:close(Type, Socket),
+ ok;
+
+send_body(#mod{socket_type = Type, socket = Sock},
+ _StatusCode, Body) when is_list(Body) ->
+ case httpd_socket:deliver(Type, Sock, Body) of
+ socket_closed ->
+ done;
+ Else ->
+ Else
+ end;
+
+send_body(#mod{socket_type = Type, socket = Sock} = ModData,
+ StatusCode, {Fun, Args}) ->
+ case (catch apply(Fun, Args)) of
+ close ->
+ httpd_socket:close(Type, Sock),
+ done;
+
+ sent ->
+ {proceed,[{response,{already_sent, StatusCode,
+ proplists:get_value(content_length,
+ ModData#mod.data)}}]};
+ {ok, Body} ->
+ case httpd_socket:deliver(Type, Sock, Body) of
+ ok ->
+ {proceed,[{response,
+ {already_sent, StatusCode,
+ proplists:get_value(content_length,
+ ModData#mod.data)}}]};
+ _ ->
+ done
+ end;
+
+ _ ->
+ done
+ end.
+
+split_header([$: | Value], AccName) ->
+ Name = http_util:to_lower(string:strip(AccName)),
+ {lists:reverse(Name),
+ string:strip(string:strip(string:strip(Value, right, ?LF), right, ?CR))};
+split_header([Char | Rest], AccName) ->
+ split_header(Rest, [Char | AccName]).
+
+send_chunk(_, <<>>, _) ->
+ ok;
+send_chunk(_, [], _) ->
+ ok;
+
+send_chunk(#mod{http_version = "HTTP/1.1",
+ socket_type = Type, socket = Sock}, Response0, false) ->
+ Response = http_chunk:encode(Response0),
+ httpd_socket:deliver(Type, Sock, Response);
+
+send_chunk(#mod{socket_type = Type, socket = Sock} = _ModData, Response, _) ->
+ httpd_socket:deliver(Type, Sock, Response).
+
+send_final_chunk(#mod{http_version = "HTTP/1.1",
+ socket_type = Type, socket = Sock}, false) ->
+ httpd_socket:deliver(Type, Sock, http_chunk:encode_last());
+send_final_chunk(#mod{socket_type = Type, socket = Sock}, _) ->
+ httpd_socket:close(Type, Sock).
+
+is_disable_chunked_send(Db) ->
+ httpd_util:lookup(Db, disable_chunked_transfer_encoding_send, false).
+
+%% 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(_,_) ->
+ "".
+
+cache_headers(#mod{config_db = Db}) ->
+ case httpd_util:lookup(Db, script_nocache, false) of
+ true ->
+ Date = httpd_util:rfc1123_date(),
+ [{"cache-control", "no-cache"},
+ {"pragma", "no-cache"},
+ {"expires", Date}];
+ false ->
+ []
+ end.
+
+create_header(KeyValueTupleHeaders) ->
+ NewHeaders = add_default_headers([{"date", httpd_util:rfc1123_date()},
+ {"content-type", "text/html"},
+ {"server", ?SERVER_SOFTWARE}],
+ KeyValueTupleHeaders),
+ lists:map(fun fix_header/1, NewHeaders).
+
+fix_header({Key0, Value}) ->
+ %% make sure first letter is capital
+ Words1 = string:tokens(Key0, "-"),
+ Words2 = upify(Words1, []),
+ Key = new_key(Words2),
+ Key ++ ": " ++ Value ++ ?CRLF .
+
+new_key([]) ->
+ "";
+new_key([W]) ->
+ W;
+new_key([W1,W2]) ->
+ W1 ++ "-" ++ W2;
+new_key([W|R]) ->
+ W ++ "-" ++ new_key(R).
+
+upify([], Acc) ->
+ lists:reverse(Acc);
+upify([Key|Rest], Acc) ->
+ upify(Rest, [upify2(Key)|Acc]).
+
+upify2([C|Rest]) when (C >= $a) andalso (C =< $z) ->
+ [C-($a-$A)|Rest];
+upify2(Str) ->
+ Str.
+
+add_default_headers([], Headers) ->
+ Headers;
+
+add_default_headers([Header = {Default, _} | Defaults], Headers) ->
+ case lists:keysearch(Default, 1, Headers) of
+ {value, _} ->
+ add_default_headers(Defaults, Headers);
+ _ ->
+ add_default_headers(Defaults, [Header | Headers])
+ end.
+
+transform({content_type, Value}) ->
+ {"content-type", Value};
+transform({accept_ranges, Value}) ->
+ {"accept-ranges", Value};
+transform({cache_control, Value}) ->
+ {"cache-control",Value};
+transform({transfer_encoding, Value}) ->
+ {"transfer-encoding", Value};
+transform({content_encoding, Value}) ->
+ {"content-encoding", Value};
+transform({content_language, Value}) ->
+ {"content-language", Value};
+transform({retry_after, Value}) ->
+ {"retry-after", Value};
+transform({content_location, Value}) ->
+ {"Content-Location:", Value};
+transform({content_length, Value}) ->
+ {"content-length", Value};
+transform({content_MD5, Value}) ->
+ {"content-md5", Value};
+transform({content_range, Value}) ->
+ {"content-range", Value};
+transform({last_modified, Value}) ->
+ {"last-modified", Value};
+transform({Field, Value}) when is_atom(Field) ->
+ {atom_to_list(Field), Value};
+transform({Field, Value}) when is_list(Field) ->
+ {Field, Value}.
+
+%%----------------------------------------------------------------------
+%% 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{method = "HEAD"} = ModData,
+ StatusCode, Response) ->
+ NewResponse = lists:flatten(Response),
+
+ case httpd_util:split(NewResponse, [?CR, ?LF, ?CR, ?LF],2) of
+ {ok, [Head, Body]} ->
+ {ok, NewHead} = handle_headers(string:tokens(Head, [?CR,?LF]), []),
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(Body)} | NewHead]);
+ {ok, [NewResponse]} ->
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(NewResponse)}]);
+ _Error ->
+ send_status(ModData, 500, "Internal Server Error")
+ end;
+
+send_response_old(#mod{socket_type = Type,
+ socket = Sock} = ModData,
+ StatusCode, Response) ->
+
+ NewResponse = lists:flatten(Response),
+
+ case httpd_util:split(NewResponse, [?CR, ?LF, ?CR, ?LF], 2) of
+ {ok, [Head, Body]} ->
+ {ok, NewHead} = handle_headers(string:tokens(Head,
+ [?CR,?LF]), []),
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(Body)} |
+ NewHead]),
+ httpd_socket:deliver(Type, Sock, Body);
+ {ok, [NewResponse]} ->
+ send_header(ModData, StatusCode, [{content_length,
+ content_length(NewResponse)}]),
+ httpd_socket:deliver(Type, Sock, NewResponse);
+
+ {error, _Reason} ->
+ send_status(ModData, 500, "Internal Server Error")
+ end.
+
+content_length(Body)->
+ integer_to_list(httpd_util:flatlength(Body)).
+
+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.
+
+handle_headers([], NewHeaders) ->
+ {ok, NewHeaders};
+
+handle_headers([Header | Headers], NewHeaders) ->
+ {FieldName, FieldValue} = split_header(Header, []),
+ handle_headers(Headers,
+ [{FieldName, FieldValue}| NewHeaders]).
+
diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl
new file mode 100644
index 0000000000..a742cbef76
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_script_env.erl
@@ -0,0 +1,144 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(httpd_script_env).
+
+-export([create_env/3]).
+
+-include("httpd.hrl").
+
+%%%=========================================================================
+%%% Internal application API
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% create_env(ScriptType, ModData, ScriptElements) -> [{EnvVariable, Value}]
+%%
+%% ScriptType = cgi | esi
+%% ModData = #mod{}
+%% ScriptElements = [{Element, Value}]
+%% Element = path_info | query_string | entity_body
+%% Value = term()
+%% EnvVariable = string() - cgi | atom() - esi
+%%
+%% Description: Creates a list of cgi/esi environment variables and
+%% there values.
+%%--------------------------------------------------------------------------
+create_env(ScriptType, ModData, ScriptElements) ->
+ create_basic_elements(ScriptType, ModData)
+ ++ create_http_header_elements(ScriptType, ModData#mod.parsed_header)
+ ++ create_script_elements(ScriptType, ModData, ScriptElements)
+ ++ create_mod_interaction_elements(ScriptType, ModData).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+create_basic_elements(esi, ModData) ->
+ {_, RemoteAddr} = (ModData#mod.init_data)#init_data.peername,
+ [{server_software, ?SERVER_SOFTWARE},
+ {server_name, (ModData#mod.init_data)#init_data.resolve},
+ {gateway_interface,?GATEWAY_INTERFACE},
+ {server_protocol, ?SERVER_PROTOCOL},
+ {server_port, httpd_util:lookup(ModData#mod.config_db,port,80)},
+ {request_method, ModData#mod.method},
+ {remote_addr, RemoteAddr},
+ {script_name, ModData#mod.request_uri}];
+
+create_basic_elements(cgi, ModData) ->
+ {_, RemoteAddr} = (ModData#mod.init_data)#init_data.peername,
+ [{"SERVER_SOFTWARE",?SERVER_SOFTWARE},
+ {"SERVER_NAME", (ModData#mod.init_data)#init_data.resolve},
+ {"GATEWAY_INTERFACE",?GATEWAY_INTERFACE},
+ {"SERVER_PROTOCOL",?SERVER_PROTOCOL},
+ {"SERVER_PORT",
+ integer_to_list(httpd_util:lookup(
+ ModData#mod.config_db, port, 80))},
+ {"REQUEST_METHOD", ModData#mod.method},
+ {"REMOTE_ADDR", RemoteAddr},
+ {"SCRIPT_NAME", ModData#mod.request_uri}].
+
+create_http_header_elements(ScriptType, Headers) ->
+ create_http_header_elements(ScriptType, Headers, []).
+
+create_http_header_elements(_, [], Acc) ->
+ Acc;
+create_http_header_elements(ScriptType, [{Name, [Value | _] = Values } |
+ Headers], Acc)
+ when is_list(Value) ->
+ NewName = lists:map(fun(X) -> if X == $- -> $_; true -> X end end, Name),
+ Element = http_env_element(ScriptType, NewName, multi_value(Values)),
+ create_http_header_elements(ScriptType, Headers, [Element | Acc]);
+
+create_http_header_elements(ScriptType, [{Name, Value} | Headers], Acc)
+ when is_list(Value) ->
+ {ok, NewName, _} = inets_regexp:gsub(Name,"-","_"),
+ Element = http_env_element(ScriptType, NewName, Value),
+ create_http_header_elements(ScriptType, Headers, [Element | Acc]).
+
+http_env_element(cgi, VarName, Value) ->
+ {"HTTP_"++ http_util:to_upper(VarName), Value};
+http_env_element(esi, VarName, Value) ->
+ {list_to_atom("http_"++ http_util:to_lower(VarName)), Value}.
+
+multi_value([]) ->
+ [];
+multi_value([Value]) ->
+ Value;
+multi_value([Value | Rest]) ->
+ Value ++ ", " ++ multi_value(Rest).
+
+create_script_elements(ScriptType, ModData, ScriptElements) ->
+ lists:flatmap(fun({Element, Data}) ->
+ create_script_elements(ScriptType,
+ Element,
+ Data, ModData)
+ end, ScriptElements).
+
+create_script_elements(esi, query_string, QueryString, _) ->
+ [{query_string, QueryString}];
+create_script_elements(cgi, query_string, QueryString, _) ->
+ [{"QUERY_STRING", QueryString}];
+create_script_elements(esi, path_info, PathInfo, ModData) ->
+ Aliases = httpd_util:multi_lookup(ModData#mod.config_db, alias),
+ {_,PathTranslated,_} =
+ mod_alias:real_name(ModData#mod.config_db, PathInfo,
+ Aliases),
+ [{path_info, PathInfo},
+ {path_translated, PathTranslated}];
+create_script_elements(cgi, path_info, PathInfo, ModData) ->
+ Aliases = httpd_util:multi_lookup(ModData#mod.config_db, alias),
+ {_,PathTranslated,_} =
+ mod_alias:real_name(ModData#mod.config_db, PathInfo,
+ Aliases),
+ [{"PATH_INFO", PathInfo},
+ {"PATH_TRANSLATED", PathTranslated}];
+create_script_elements(esi, entity_body, Body, _) ->
+ [{content_length, httpd_util:flatlength(Body)}];
+create_script_elements(cgi, entity_body, Body, _) ->
+ [{"CONTENT_LENGTH", httpd_util:flatlength(Body)}];
+create_script_elements(_, _, _, _) ->
+ [].
+
+create_mod_interaction_elements(_, ModData)->
+ case proplists:get_value(remote_user, ModData#mod.data) of
+ undefined ->
+ [];
+ RemoteUser ->
+ [{remote_user, RemoteUser}]
+ end.
diff --git a/lib/inets/src/http_server/httpd_socket.erl b/lib/inets/src/http_server/httpd_socket.erl
new file mode 100644
index 0000000000..e9d3e06b38
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_socket.erl
@@ -0,0 +1,64 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_socket).
+
+%% API (document close ?)
+-export([deliver/3, peername/2, resolve/0, close/2]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"SOCKET").
+-include_lib("kernel/include/inet.hrl").
+
+deliver(SocketType, Socket, IOListOrBinary) ->
+ case http_transport:send(SocketType, Socket, IOListOrBinary) of
+ {error, _Reason} ->
+ (catch close(SocketType, Socket)),
+ socket_closed;
+ _ ->
+ ok
+ end.
+
+peername(SocketType, Socket) ->
+ http_transport:peername(SocketType, Socket).
+
+resolve() ->
+ http_transport:resolve().
+
+close(SocketType, Socket) ->
+ close_sleep(SocketType, 1000),
+ Res =
+ case (catch http_transport:close(SocketType, Socket)) of
+ ok -> ok;
+ {error,Reason} -> {error,Reason};
+ {'EXIT',{noproc,_}} -> {error,closed};
+ {'EXIT',Reason} -> {error,Reason};
+ Otherwise -> {error,Otherwise}
+ end,
+ Res.
+
+%% Workaround for ssl problem when ssl does not deliver the message
+%% sent prior to the close before the close signal.
+close_sleep({ssl, _}, Time) ->
+ sleep(Time);
+close_sleep(_, _) ->
+ ok.
+
+sleep(T) -> receive after T -> ok end.
diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl
new file mode 100644
index 0000000000..fc41994727
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_sup.erl
@@ -0,0 +1,264 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for the http server (httpd) hangs under
+%% inets_sup.
+%%----------------------------------------------------------------------
+
+-module(httpd_sup).
+
+-behaviour(supervisor).
+
+%% Internal application API
+-export([start_link/1, start_link/2]).
+-export([start_child/1, restart_child/2, stop_child/2]).
+
+%% Supervisor callback
+-export([init/1]).
+
+-export([listen_init/4]).
+
+-define(TIMEOUT, 15000).
+-include("httpd_internal.hrl").
+
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+start_link(HttpdServices) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, [HttpdServices]).
+
+start_link(HttpdServices, stand_alone) ->
+ supervisor:start_link(?MODULE, [HttpdServices]).
+
+start_child(Config) ->
+ try httpd_config(Config) of
+ {ok, NewConfig} ->
+ Spec = httpd_child_spec(NewConfig, ?TIMEOUT, []),
+ case supervisor:start_child(?MODULE, Spec) of
+ {error, {invalid_child_spec, Error}} ->
+ Error;
+ Other ->
+ Other
+ end
+ catch
+ throw:Error ->
+ Error
+ end.
+
+
+restart_child(Address, Port) ->
+ Name = id(Address, Port),
+ case supervisor:terminate_child(?MODULE, Name) of
+ ok ->
+ supervisor:restart_child(?MODULE, Name);
+ Error ->
+ Error
+ end.
+
+stop_child(Address, Port) ->
+ Name = id(Address, Port),
+ case supervisor:terminate_child(?MODULE, Name) of
+ ok ->
+ supervisor:delete_child(?MODULE, Name);
+ Error ->
+ Error
+ end.
+
+id(Address, Port) ->
+ {httpd_instance_sup, Address, Port}.
+
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+init([HttpdServices]) ->
+ ?hdrd("starting", []),
+ RestartStrategy = one_for_one,
+ MaxR = 10,
+ MaxT = 3600,
+ Children = child_specs(HttpdServices, []),
+ {ok, {{RestartStrategy, MaxR, MaxT}, Children}}.
+
+
+%%%=========================================================================
+%%% Internal functions
+%%%=========================================================================
+
+%% The format of the httpd service is:
+%% httpd_service() -> {httpd,httpd()}
+%% httpd() -> [httpd_config()] | file()
+%% httpd_config() -> {file,file()} |
+%% {debug,debug()} |
+%% {accept_timeout,integer()}
+%% debug() -> disable | [debug_options()]
+%% debug_options() -> {all_functions,modules()} |
+%% {exported_functions,modules()} |
+%% {disable,modules()}
+%% modules() -> [atom()]
+
+
+child_specs([], Acc) ->
+ Acc;
+child_specs([{httpd, HttpdService} | Rest], Acc) ->
+ ?hdrd("child specs", [{httpd, HttpdService}]),
+ NewHttpdService = (catch mk_tuple_list(HttpdService)),
+ ?hdrd("child specs", [{new_httpd, NewHttpdService}]),
+ case catch child_spec(NewHttpdService) of
+ {error, Reason} ->
+ ?hdri("failed generating child spec", [{reason, Reason}]),
+ error_msg("Failed to start service: ~n~p ~n due to: ~p~n",
+ [HttpdService, Reason]),
+ child_specs(Rest, Acc);
+ Spec ->
+ ?hdrt("child spec", [{child_spec, Spec}]),
+ child_specs(Rest, [Spec | Acc])
+ end.
+
+child_spec(HttpdService) ->
+ {ok, Config} = httpd_config(HttpdService),
+ ?hdrt("child spec", [{config, Config}]),
+ Debug = proplists:get_value(debug, Config, []),
+ AcceptTimeout = proplists:get_value(accept_timeout, Config, 15000),
+ httpd_util:valid_options(Debug, AcceptTimeout, Config),
+ httpd_child_spec(Config, AcceptTimeout, Debug).
+
+httpd_config([Value| _] = Config) when is_tuple(Value) ->
+ case proplists:get_value(file, Config) of
+ undefined ->
+ case proplists:get_value(proplist_file, Config) of
+ undefined ->
+ httpd_conf:validate_properties(Config);
+ File ->
+ try file:consult(File) of
+ {ok, [PropList]} ->
+ httpd_conf:validate_properties(PropList)
+ catch
+ exit:_ ->
+ throw({error,
+ {could_not_consult_proplist_file, File}})
+ end
+ end;
+ File ->
+ {ok, File}
+ end.
+
+httpd_child_spec([Value| _] = Config, AcceptTimeout, Debug)
+ when is_tuple(Value) ->
+ Address = proplists:get_value(bind_address, Config, any),
+ Port = proplists:get_value(port, Config, 80),
+ httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port);
+
+httpd_child_spec(ConfigFile, AcceptTimeout, Debug) ->
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ case httpd_conf:validate_properties(ConfigList) of
+ {ok, Config} ->
+ Address = proplists:get_value(bind_address, Config, any),
+ Port = proplists:get_value(port, Config, 80),
+ httpd_child_spec([{file, ConfigFile} | Config],
+ AcceptTimeout, Debug, Address, Port);
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+httpd_child_spec(Config, AcceptTimeout, Debug, Addr, 0) ->
+ case start_listen(Addr, 0, Config) of
+ {Pid, {NewPort, NewConfig, ListenSocket}} ->
+ Name = {httpd_instance_sup, Addr, NewPort},
+ StartFunc = {httpd_instance_sup, start_link,
+ [NewConfig, AcceptTimeout,
+ {Pid, ListenSocket}, Debug]},
+ Restart = permanent,
+ Shutdown = infinity,
+ Modules = [httpd_instance_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules};
+ {Pid, {error, Reason}} ->
+ exit(Pid, normal),
+ {error, Reason}
+ end;
+
+httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port) ->
+ Name = {httpd_instance_sup, Addr, Port},
+ StartFunc = {httpd_instance_sup, start_link,
+ [Config, AcceptTimeout, Debug]},
+ Restart = permanent,
+ Shutdown = infinity,
+ Modules = [httpd_instance_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+
+mk_tuple_list([]) ->
+ [];
+mk_tuple_list([H={_,_}|T]) ->
+ [H|mk_tuple_list(T)];
+mk_tuple_list(F) ->
+ [{file, F}].
+
+error_msg(F, A) ->
+ error_logger:error_msg(F ++ "~n", A).
+
+listen(Address, Port, Config) ->
+ SocketType = proplists:get_value(socket_type, Config, ip_comm),
+ case http_transport:start(SocketType) of
+ ok ->
+ case http_transport:listen(SocketType, Address, Port) of
+ {ok, ListenSocket} ->
+ NewConfig = proplists:delete(port, Config),
+ {ok, NewPort} = inet:port(ListenSocket),
+ {NewPort, [{port, NewPort} | NewConfig], ListenSocket};
+ {error, Reason} ->
+ {error, {listen, Reason}}
+ end;
+ {error, Reason} ->
+ {error, {socket_start_failed, Reason}}
+ end.
+
+start_listen(Address, Port, Config) ->
+ Pid = listen_owner(Address, Port, Config),
+ receive
+ {Pid, Result} ->
+ {Pid, Result}
+ end.
+
+listen_owner(Address, Port, Config) ->
+ spawn(?MODULE, listen_init, [self(), Address, Port, Config]).
+
+listen_init(From, Address, Port, Config) ->
+ process_flag(trap_exit, true),
+ Result = listen(Address, Port, Config),
+ From ! {self(), Result},
+ listen_loop().
+
+listen_loop() ->
+ receive
+ {'EXIT', _, _} ->
+ ok
+ end.
+
+
+
+
+
diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl
new file mode 100644
index 0000000000..b59fd861dc
--- /dev/null
+++ b/lib/inets/src/http_server/httpd_util.erl
@@ -0,0 +1,780 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(httpd_util).
+-export([ip_address/2, 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,
+ flatlength/1, split_path/1, split_script_path/1,
+ suffix/1, split/3, 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,
+ convert_netscapecookie_date/1, enable_debug/1, valid_options/3,
+ modules_validate/1, module_validate/1,
+ dir_validate/2, file_validate/2, mime_type_validate/1,
+ mime_types_validate/1, custom_date/0]).
+
+-export([encode_hex/1]).
+-include_lib("kernel/include/file.hrl").
+
+ip_address({_,_,_,_} = Address, _IpFamily) ->
+ {ok, Address};
+ip_address({_,_,_,_,_,_,_,_} = Address, _IpFamily) ->
+ {ok, Address};
+ip_address(Host, IpFamily)
+ when ((IpFamily =:= inet) orelse (IpFamily =:= inet6)) ->
+ inet:getaddr(Host, IpFamily);
+ip_address(Host, inet6fb4 = _IpFamily) ->
+ Inet = case gen_tcp:listen(0, [inet6]) of
+ {ok, Dummyport} ->
+ gen_tcp:close(Dummyport),
+ inet6;
+ _ ->
+ inet
+ end,
+ inet:getaddr(Host, Inet).
+
+
+%% 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.
+
+%%% RFC 2616, HTTP 1.1 Status codes
+reason_phrase(100) -> "Continue";
+reason_phrase(101) -> "Switching Protocols" ;
+reason_phrase(200) -> "OK" ;
+reason_phrase(201) -> "Created" ;
+reason_phrase(202) -> "Accepted" ;
+reason_phrase(203) -> "Non-Authoritative Information" ;
+reason_phrase(204) -> "No Content" ;
+reason_phrase(205) -> "Reset Content" ;
+reason_phrase(206) -> "Partial Content" ;
+reason_phrase(300) -> "Multiple Choices" ;
+reason_phrase(301) -> "Moved Permanently" ;
+reason_phrase(302) -> "Moved Temporarily" ;
+reason_phrase(303) -> "See Other" ;
+reason_phrase(304) -> "Not Modified" ;
+reason_phrase(305) -> "Use Proxy" ;
+reason_phrase(306) -> "(unused)" ;
+reason_phrase(307) -> "Temporary Redirect" ;
+reason_phrase(400) -> "Bad Request";
+reason_phrase(401) -> "Unauthorized";
+reason_phrase(402) -> "Payment Required";
+reason_phrase(403) -> "Forbidden" ;
+reason_phrase(404) -> "Object Not Found" ;
+reason_phrase(405) -> "Method Not Allowed" ;
+reason_phrase(406) -> "Not Acceptable" ;
+reason_phrase(407) -> "Proxy Authentication Required" ;
+reason_phrase(408) -> "Request Time-out" ;
+reason_phrase(409) -> "Conflict" ;
+reason_phrase(410) -> "Gone" ;
+reason_phrase(411) -> "Length Required" ;
+reason_phrase(412) -> "Precondition Failed" ;
+reason_phrase(413) -> "Request Entity Too Large" ;
+reason_phrase(414) -> "Request-URI Too Large" ;
+reason_phrase(415) -> "Unsupported Media Type" ;
+reason_phrase(416) -> "Requested 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(504) -> "Gateway Time-out" ;
+reason_phrase(505) -> "HTTP Version not supported";
+
+%%% RFC 2518, HTTP Extensions for Distributed Authoring -- WEBDAV
+reason_phrase(102) -> "Processing";
+reason_phrase(207) -> "Multi-Status";
+reason_phrase(422) -> "Unprocessable Entity";
+reason_phrase(423) -> "Locked";
+reason_phrase(424) -> "Failed Dependency";
+reason_phrase(507) -> "Insufficient Storage";
+
+%%% (Work in Progress) WebDAV Advanced Collections
+reason_phrase(425) -> "";
+
+%%% RFC 2817, HTTP Upgrade to TLS
+reason_phrase(426) -> "Upgrade Required";
+
+%%% RFC 3229, Delta encoding in HTTP
+reason_phrase(226) -> "IM Used";
+
+reason_phrase(_) -> "Internal Server Error".
+
+
+%% message
+
+message(301,URL,_) ->
+ "The document has moved <A HREF=\""++URL++"\">here</A>.";
+message(304, _URL,_) ->
+ "The document has not been changed.";
+message(400,none,_) ->
+ "Your browser sent a query that this server could not understand.";
+message(400,Msg,_) ->
+ "Your browser sent a query that this server could not understand. "++Msg;
+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 doesn't understand how to supply
+the credentials required.";
+message(403,RequestURI,_) ->
+ "You don't have permission to access "++RequestURI++" on this server.";
+message(404,RequestURI,_) ->
+ "The requested URL "++RequestURI++" was not found on this server.";
+message(408, Timeout, _) ->
+ Timeout;
+message(412,none,_) ->
+ "The requested preconditions where false";
+message(413, Reason,_) ->
+ "Entity: " ++ Reason;
+message(414,ReasonPhrase,_) ->
+ "Message "++ReasonPhrase++".";
+message(416,ReasonPhrase,_) ->
+ ReasonPhrase;
+
+message(500,_,ConfigDB) ->
+ ServerAdmin=lookup(ConfigDB,server_admin,"unknown@unknown"),
+ "The server encountered an internal error or "
+ "misconfiguration and was unable to complete "
+ "your request.<P>Please contact the server administrator "
+ ++ ServerAdmin ++ ", and inform them of the time the error occurred "
+ "and anything you might have done that may have caused the error.";
+
+message(501,{Method, RequestURI, HTTPVersion}, _ConfigDB) ->
+ if
+ is_atom(Method) ->
+ atom_to_list(Method)++
+ " to "++RequestURI++" ("++HTTPVersion++") not supported.";
+ is_list(Method) ->
+ Method++
+ " to "++RequestURI++" ("++HTTPVersion++") not supported."
+ end;
+
+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) ->
+ [_WeekDay,Date,Time,_TimeZone|_Rest] = string:tokens(DateStr," "),
+ convert_rfc850_date(Date,Time).
+
+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 = http_util: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([_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=http_util: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([_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=http_util: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_netscapecookie_date(Date)->
+ case (catch http_util:convert_netscapecookie_date(Date)) of
+ Ret = {ok, _} ->
+ Ret;
+ _ ->
+ {error,bad_date}
+ end.
+
+
+%% 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(undefined) ->
+ undefined;
+rfc1123_date(LocalTime) ->
+ {{YYYY,MM,DD},{Hour,Min,Sec}} =
+ case calendar:local_time_to_universal_time_dst(LocalTime) of
+ [Gmt] -> Gmt;
+ [_,Gmt] -> Gmt
+ end,
+ 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])).
+
+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) ->
+ $-.
+
+%% 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) andalso (X=<$9) -> X-$0;
+hex2dec(X) when (X>=$A) andalso (X=<$F) -> X-$A+10;
+hex2dec(X) when (X>=$a) andalso (X=<$f) -> X-$a+10.
+
+%% flatlength
+flatlength(List) ->
+ flatlength(List, 0).
+
+flatlength([H|T],L) when is_list(H) ->
+ flatlength(H,flatlength(T,L));
+flatlength([H|T],L) when is_binary(H) ->
+ flatlength(T,L+size(H));
+flatlength([_H|T],L) ->
+ flatlength(T,L+1);
+flatlength([],L) ->
+ L.
+
+%% split_path
+
+split_path(Path) ->
+ case inets_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.
+
+
+%% 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 inets_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 inets_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.
+
+%% 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({A, B, C, D, E, F, G, H}) ->
+ io_lib:format("~s_~s_~s_~s_~s_~s_~s_~s", [integer_to_hexlist(A),
+ integer_to_hexlist(B),
+ integer_to_hexlist(C),
+ integer_to_hexlist(D),
+ integer_to_hexlist(E),
+ integer_to_hexlist(F),
+ integer_to_hexlist(G),
+ integer_to_hexlist(H)
+ ]);
+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(List)->
+ http_util:hexlist_to_integer(List).
+
+%%----------------------------------------------------------------------
+%%Converts an integer to an hexlist
+%%----------------------------------------------------------------------
+encode_hex(Num)->
+ integer_to_hexlist(Num).
+
+integer_to_hexlist(Num) when is_integer(Num) ->
+ http_util:integer_to_hexlist(Num).
+
+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).
+
+%%----------------------------------------------------------------------
+%% Validate httpd options
+%%----------------------------------------------------------------------
+modules_validate([]) ->
+ ok;
+modules_validate([Head | Tail]) ->
+ ok = module_validate(Head),
+ modules_validate(Tail).
+
+module_validate(Module) when is_atom(Module) ->
+ case code:which(Module) of
+ non_existing ->
+ throw({module_does_not_exist, Module});
+ _ ->
+ ok
+ end;
+
+module_validate(Module) ->
+ throw({module_name_not_atom, Module}).
+
+dir_validate(ConfDir, Dir) ->
+ case filelib:is_dir(Dir) of
+ true ->
+ ok;
+ false when is_list(Dir) ->
+ throw({non_existing, {ConfDir, Dir}});
+ false ->
+ throw({ConfDir, Dir})
+ end.
+
+file_validate(ConfFile, File) ->
+ case filelib:is_file(File) of
+ true ->
+ ok;
+ false when is_list(File) ->
+ throw({non_existing, {ConfFile, File}});
+ false ->
+ throw({ConfFile, File})
+ end.
+
+mime_type_validate({Value1, Value2})
+ when is_list(Value1) andalso is_list(Value2) ->
+ ok;
+mime_type_validate({_, _} = Value) ->
+ throw({mime_type, Value});
+mime_type_validate(MimeFile) ->
+ file_validate(mime_types, MimeFile).
+
+mime_types_validate([{_, _} = Value | Rest]) ->
+ ok = mime_types_validate(Value),
+ mime_types_validate(Rest);
+mime_types_validate([]) ->
+ ok;
+mime_types_validate(MimeFile) ->
+ mime_type_validate(MimeFile).
+
+
+valid_options(Debug, AcceptTimeout, Config) ->
+ valid_debug(Debug),
+ valid_accept_timeout(AcceptTimeout),
+ valid_config(Config).
+
+valid_debug([]) ->
+ ok;
+valid_debug(disable) ->
+ ok;
+valid_debug(L) when is_list(L) ->
+ valid_debug2(L);
+valid_debug(D) ->
+ throw({error, {bad_debug_option,D}}).
+
+valid_debug2([{all_functions,L}|Rest]) when is_list(L) ->
+ try modules_validate(L) of
+ ok ->
+ valid_debug2(Rest)
+ catch
+ throw:Error ->
+ throw({error, Error})
+ end;
+valid_debug2([{exported_functions,L}|Rest]) when is_list(L) ->
+ modules_validate(L),
+ valid_debug2(Rest);
+valid_debug2([{disable,L}|Rest]) when is_list(L) ->
+ modules_validate(L),
+ valid_debug2(Rest);
+valid_debug2([H|_T]) ->
+ throw({error,{bad_debug_option,H}});
+valid_debug2([]) ->
+ ok.
+
+valid_accept_timeout(I) when is_integer(I) ->
+ ok;
+valid_accept_timeout(A) ->
+ throw({error,{bad_debug_option,A}}).
+
+valid_config(_) ->
+ ok.
+
+
+%%----------------------------------------------------------------------
+%% Enable debugging,
+%%----------------------------------------------------------------------
+
+enable_debug([]) ->
+ ok;
+enable_debug(Debug) ->
+ dbg:tracer(),
+ dbg:p(all, [call]),
+ do_enable_debug(Debug).
+
+do_enable_debug(disable) ->
+ dbg:stop();
+do_enable_debug([]) ->
+ ok;
+do_enable_debug([{Level,Modules}|Rest])
+ when is_atom(Level) andalso is_list(Modules) ->
+ case Level of
+ all_functions ->
+ io:format("Tracing on all functions set on modules: ~p~n",
+ [Modules]),
+ lists:foreach(
+ fun(X)->
+ dbg:tpl(X, [{'_', [], [{return_trace}]}])
+ end, Modules);
+ exported_functions ->
+ io:format("Tracing on exported functions set on "
+ "modules: ~p~n",[Modules]),
+ lists:foreach(
+ fun(X)->
+ dbg:tp(X, [{'_', [], [{return_trace}]}])
+ end, Modules);
+ disable ->
+ io:format("Tracing disabled on modules: ~p~n", [Modules]),
+ lists:foreach(
+ fun(X)->
+ dbg:ctp(X)
+ end, Modules);
+ _ ->
+ ok
+ end,
+ do_enable_debug(Rest).
diff --git a/lib/inets/src/http_server/mod_actions.erl b/lib/inets/src/http_server/mod_actions.erl
new file mode 100644
index 0000000000..d50ed4b16c
--- /dev/null
+++ b/lib/inets/src/http_server/mod_actions.erl
@@ -0,0 +1,117 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_actions).
+-export([do/1,load/2, store/2]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) 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("Action "++ Action, []) ->
+ case inets_regexp:split(Action, " ") of
+ {ok,[MimeType, CGIScript]} ->
+ {ok,[],{action, {MimeType, CGIScript}}};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Action)++" is an invalid Action")}
+ end;
+load("Script " ++ Script,[]) ->
+ case inets_regexp:split(Script, " ") of
+ {ok,[Method, CGIScript]} ->
+ {ok,[],{script, {Method, CGIScript}}};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Script)++" is an invalid Script")}
+ end.
+
+store({action, {MimeType, CGIScript}} = Conf, _) when is_list(MimeType),
+ is_list(CGIScript) ->
+ {ok, Conf};
+store({action, Value}, _) ->
+ {error, {wrong_type, {action, Value}}};
+
+store({script, {Method, CGIScript}} = Conf, _) when is_list(Method),
+ is_list(CGIScript) ->
+ case string:to_lower(Method) of
+ "get" ->
+ {ok, Conf};
+ "post" ->
+ {ok, Conf};
+ _ ->
+ {error, {wrong_type, Conf}}
+ end;
+
+store({script, Value}, _) ->
+ {error, {wrong_type, {script, Value}}}.
+
+
+
diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl
new file mode 100644
index 0000000000..7073f5405d
--- /dev/null
+++ b/lib/inets/src/http_server/mod_alias.erl
@@ -0,0 +1,210 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_alias).
+
+-export([do/1,
+ real_name/3,
+ real_script_name/3,
+ default_index/2,
+ load/2,
+ store/2,
+ path/3]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"ALIAS").
+
+%% do
+
+do(Info) ->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) 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) ->
+ {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 /= $/ ->
+ ServerName = httpd_util:lookup(Info#mod.config_db, server_name),
+ Port = port_string(httpd_util:lookup(Info#mod.config_db,port, 80)),
+ URL = "http://" ++ ServerName ++ Port ++
+ Info#mod.request_uri ++ "/",
+ ReasonPhrase = httpd_util:reason_phrase(301),
+ Message = httpd_util:message(301, URL, Info#mod.config_db),
+ {proceed,
+ [{response,
+ {301, ["Location: ", URL, "\r\n"
+ "Content-Type: text/html\r\n",
+ "\r\n",
+ "<HTML>\n<HEAD>\n<TITLE>",ReasonPhrase,
+ "</TITLE>\n</HEAD>\n"
+ "<BODY>\n<H1>",ReasonPhrase,
+ "</H1>\n", Message,
+ "\n</BODY>\n</HTML>\n"]}}|
+ [{real_name, {Path, AfterPath}} | Info#mod.data]]};
+ _NoFile ->
+ {proceed,[{real_name, {Path, AfterPath}} | Info#mod.data]}
+ end.
+
+port_string(80) ->
+ "";
+port_string(Port) ->
+ ":"++integer_to_list(Port).
+
+%% real_name
+
+real_name(ConfigDB, RequestURI, []) ->
+ DocumentRoot = httpd_util:lookup(ConfigDB, document_root, ""),
+ RealName = DocumentRoot ++ RequestURI,
+ {ShortPath, _AfterPath} = httpd_util:split_path(RealName),
+ {Path, AfterPath} = httpd_util:split_path(default_index(ConfigDB,
+ RealName)),
+ {ShortPath, Path, AfterPath};
+real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) ->
+ case inets_regexp:match(RequestURI, "^" ++ FakeName) of
+ {match, _, _} ->
+ {ok, ActualName, _} = inets_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 inets_regexp:match(RequestURI,"^"++FakeName) of
+ {match,_,_} ->
+ {ok,ActualName,_}=inets_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 proplists:get_value(real_name, Data) 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("DirectoryIndex " ++ DirectoryIndex, []) ->
+ {ok, DirectoryIndexes} = inets_regexp:split(DirectoryIndex," "),
+ {ok,[], {directory_index, DirectoryIndexes}};
+load("Alias " ++ Alias,[]) ->
+ case inets_regexp:split(Alias," ") of
+ {ok, [FakeName, RealName]} ->
+ {ok,[],{alias,{FakeName,RealName}}};
+ {ok, _} ->
+ {error,?NICE(httpd_conf:clean(Alias)++" is an invalid Alias")}
+ end;
+load("ScriptAlias " ++ ScriptAlias, []) ->
+ case inets_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.
+
+store({directory_index, Value} = Conf, _) when is_list(Value) ->
+ case is_directory_index_list(Value) of
+ true ->
+ {ok, Conf};
+ false ->
+ {error, {wrong_type, {directory_index, Value}}}
+ end;
+store({directory_index, Value}, _) ->
+ {error, {wrong_type, {directory_index, Value}}};
+store({alias, {Fake, Real}} = Conf, _) when is_list(Fake),
+ is_list(Real) ->
+ {ok, Conf};
+store({alias, Value}, _) ->
+ {error, {wrong_type, {alias, Value}}};
+store({script_alias, {Fake, Real}} = Conf, _) when is_list(Fake),
+ is_list(Real) ->
+ {ok, Conf};
+store({script_alias, Value}, _) ->
+ {error, {wrong_type, {script_alias, Value}}}.
+
+is_directory_index_list([]) ->
+ true;
+is_directory_index_list([Head | Tail]) when is_list(Head) ->
+ is_directory_index_list(Tail);
+is_directory_index_list(_) ->
+ false.
diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl
new file mode 100644
index 0000000000..07cafb4726
--- /dev/null
+++ b/lib/inets/src/http_server/mod_auth.erl
@@ -0,0 +1,797 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-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").
+-include("httpd_internal.hrl").
+
+-define(VMODULE,"AUTH").
+
+-define(NOPASSWORD,"NoPassword").
+
+%% do
+do(Info) ->
+ ?hdrt("do", [{info, Info}]),
+ case proplists:get_value(status,Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed, Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) 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}} ->
+ ?hdrt("secret area",
+ [{directory, Directory},
+ {directory_data, DirectoryData}]),
+
+ %% Authenticate (allow)
+ case allow((Info#mod.init_data)#init_data.peername,
+ Info#mod.socket_type,Info#mod.socket,
+ DirectoryData) of
+ allowed ->
+ ?hdrt("allowed", []),
+ case deny((Info#mod.init_data)#init_data.peername,
+ Info#mod.socket_type,
+ Info#mod.socket,
+ DirectoryData) of
+ not_denied ->
+ ?hdrt("not denied", []),
+ case proplists:get_value(auth_type,
+ DirectoryData) of
+ undefined ->
+ {proceed, Info#mod.data};
+ none ->
+ {proceed, Info#mod.data};
+ AuthType ->
+ do_auth(Info,
+ Directory,
+ DirectoryData,
+ AuthType)
+ end;
+ {denied, Reason} ->
+ ?hdrt("denied", [{reason, Reason}]),
+ {proceed,
+ [{status, {403,
+ Info#mod.request_uri,
+ Reason}}|
+ Info#mod.data]}
+ end;
+ {not_allowed, Reason} ->
+ ?hdrt("not allowed", [{reason, 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)
+ ?hdrt("authenticate", [{auth_type, AuthType}]),
+ case require(Info, Directory, DirectoryData) of
+ authorized ->
+ ?hdrt("authorized", []),
+ {proceed,Info#mod.data};
+ {authorized, User} ->
+ ?hdrt("authorized", [{user, User}]),
+ {proceed, [{remote_user,User}|Info#mod.data]};
+ {authorization_required, Realm} ->
+ ?hdrt("authorization required", [{realm, Realm}]),
+ ReasonPhrase = httpd_util:reason_phrase(401),
+ Message = httpd_util:message(401,none,Info#mod.config_db),
+ {proceed,
+ [{response,
+ {401,
+ ["WWW-Authenticate: Basic realm=\"",Realm,
+ "\"\r\n\r\n","<HTML>\n<HEAD>\n<TITLE>",
+ ReasonPhrase,"</TITLE>\n",
+ "</HEAD>\n<BODY>\n<H1>",ReasonPhrase,
+ "</H1>\n",Message,"\n</BODY>\n</HTML>\n"]}}|
+ Info#mod.data]};
+ {status, {StatusCode,PhraseArgs,Reason}} ->
+ {proceed, [{status,{StatusCode,PhraseArgs,Reason}}|
+ Info#mod.data]}
+ end.
+
+%% require
+
+require(Info, Directory, DirectoryData) ->
+ ParsedHeader = Info#mod.parsed_header,
+ ValidUsers = proplists:get_value(require_user, DirectoryData),
+ ValidGroups = proplists:get_value(require_group, DirectoryData),
+ %% Any user or group restrictions?
+ case ValidGroups of
+ undefined when ValidUsers =:= undefined ->
+ authorized;
+ _ ->
+ case proplists:get_value("authorization", ParsedHeader) of
+ undefined ->
+ authorization_required(DirectoryData);
+ %% Check credentials!
+ "Basic" ++ EncodedString = Credentials ->
+ case (catch base64:decode_to_string(EncodedString)) of
+ {'EXIT',{function_clause, _}} ->
+ {status, {401, none, ?NICE("Bad credentials "++
+ Credentials)}};
+ DecodedString ->
+ validate_user(Info, Directory, DirectoryData,
+ ValidUsers, ValidGroups,
+ DecodedString)
+ end;
+ %% Bad credentials!
+ BadCredentials ->
+ {status, {401, none, ?NICE("Bad credentials "++
+ BadCredentials)}}
+ end
+ end.
+
+authorization_required(DirectoryData) ->
+ case proplists:get_value(auth_name, DirectoryData) of
+ undefined ->
+ {status,{500, none,?NICE("AuthName directive not specified")}};
+ Realm ->
+ {authorization_required, Realm}
+ end.
+
+
+validate_user(Info, Directory, DirectoryData, ValidUsers,
+ ValidGroups, DecodedString) ->
+ case a_valid_user(Info, DecodedString,
+ ValidUsers, ValidGroups,
+ Directory, DirectoryData) of
+ {yes, User} ->
+ {authorized, User};
+ {no, _Reason} ->
+ authorization_required(DirectoryData);
+ {status, {StatusCode,PhraseArgs,Reason}} ->
+ {status,{StatusCode,PhraseArgs,Reason}}
+ 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;
+ _ ->
+ 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};
+ _ ->
+ {no, "No such user"} % Don't say 'Bad Password' !!!
+ end;
+ _Other ->
+ {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 proplists:get_value(auth_type, DirData, 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 inets_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 = proplists:get_value(allow_from, DirectoryData, 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]) ->
+ case inets_regexp:match(RemoteAddr, HostRegExp) of
+ {match,_,_} ->
+ true;
+ nomatch ->
+ validate_addr(RemoteAddr,Rest)
+ end.
+
+%% deny
+
+deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) ->
+ Hosts = proplists:get_value(deny_from, DirectoryData, none),
+ case validate_addr(RemoteAddr,Hosts) of
+ true ->
+ {denied, ?NICE("Connection from your host is not allowed")};
+ false ->
+ not_denied
+ end.
+
+%%
+%% Configuration
+%%
+
+%% load/2
+%%
+
+%% mod_auth recognizes the following Configuration Directives:
+%% <Directory /path/to/directory>
+%% AuthDBType
+%% AuthName
+%% AuthUserFile
+%% AuthGroupFile
+%% AuthAccessPassword
+%% require
+%% allow
+%% </Directory>
+
+%% When a <Directory> directive is found, a new context is set to
+%% [{directory, Directory, DirData}|OtherContext]
+%% DirData in this case is a key-value list of data belonging to the
+%% directory in question.
+%%
+%% When the </Directory> statement is found, the Context created earlier
+%% will be returned as a ConfigList and the context will return to the
+%% state it was previously.
+
+load("<Directory " ++ 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("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) ->
+ {ok, [{directory, {Directory,
+ [{auth_name, httpd_conf:clean(AuthName)} | DirData]}}
+ | Rest ]};
+load("AuthUserFile " ++ AuthUserFile0,
+ [{directory, {Directory, DirData}}|Rest]) ->
+ AuthUserFile = httpd_conf:clean(AuthUserFile0),
+ {ok, [{directory, {Directory,
+ [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]};
+load("AuthGroupFile " ++ AuthGroupFile0,
+ [{directory, {Directory, DirData}}|Rest]) ->
+ AuthGroupFile = httpd_conf:clean(AuthGroupFile0),
+ {ok,[{directory, {Directory,
+ [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]};
+
+%AuthAccessPassword
+load("AuthAccessPassword " ++ AuthAccessPassword0,
+ [{directory, {Directory, DirData}}|Rest]) ->
+ AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0),
+ {ok,[{directory, {Directory,
+ [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]};
+
+load("AuthDBType " ++ 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("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) ->
+ case inets_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("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) ->
+ case inets_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("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) ->
+ case inets_regexp:split(Deny," ") of
+ {ok, ["from", "all"]} ->
+ {ok,[{{directory, Directory,
+ [{deny_from, all}|DirData]}} | Rest]};
+ {ok, ["from"|Hosts]} ->
+ {ok,[{{directory, Directory,
+ [{deny_from, Hosts}|DirData]}} | Rest]};
+ {ok, _} ->
+ {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")}
+ end;
+
+load("</Directory>",[{directory, {Directory, DirData}}|Rest]) ->
+ {ok, Rest, {directory, {Directory, DirData}}};
+
+load("AuthMnesiaDB " ++ 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.
+
+directory_config_check(Directory, DirData) ->
+ case proplists:get_value(auth_type, DirData) of
+ plain ->
+ check_filename_present(Directory,auth_user_file,DirData),
+ check_filename_present(Directory,auth_group_file,DirData);
+ _ ->
+ ok
+ end.
+check_filename_present(Dir,AuthFile,DirData) ->
+ case proplists:get_value(AuthFile,DirData) of
+ Name when is_list(Name) ->
+ ok;
+ _ ->
+ throw({missing_auth_file, AuthFile, {directory, {Dir, DirData}}})
+ end.
+
+%% store
+
+store({directory, {Directory, DirData}}, ConfigList)
+ when is_list(Directory) andalso is_list(DirData) ->
+ ?hdrt("store",
+ [{directory, Directory}, {dir_data, DirData}]),
+ try directory_config_check(Directory, DirData) of
+ ok ->
+ store_directory(Directory, DirData, ConfigList)
+ catch
+ throw:Error ->
+ {error, Error, {directory, Directory, DirData}}
+ end;
+store({directory, {Directory, DirData}}, _) ->
+ {error, {wrong_type, {directory, {Directory, DirData}}}}.
+
+store_directory(Directory0, DirData0, ConfigList) ->
+ ?hdrt("store directory - entry",
+ [{directory, Directory0}, {dir_data, DirData0}]),
+ Port = proplists:get_value(port, ConfigList),
+ DirData = case proplists:get_value(bind_address, ConfigList) of
+ undefined ->
+ [{port, Port}|DirData0];
+ Addr ->
+ [{port, Port},{bind_address,Addr}|DirData0]
+ end,
+ Directory =
+ case filename:pathtype(Directory0) of
+ relative ->
+ SR = proplists:get_value(server_root, ConfigList),
+ filename:join(SR, Directory0);
+ _ ->
+ Directory0
+ end,
+ AuthMod =
+ case proplists:get_value(auth_type, DirData0) of
+ mnesia -> mod_auth_mnesia;
+ dets -> mod_auth_dets;
+ plain -> mod_auth_plain;
+ _ -> no_module_at_all
+ end,
+ ?hdrt("store directory",
+ [{directory, Directory}, {dir_data, DirData}, {auth_mod, AuthMod}]),
+ case AuthMod of
+ no_module_at_all ->
+ {ok, {directory, {Directory, DirData}}};
+ _ ->
+ %% Check that there are a password or add a standard password:
+ %% "NoPassword"
+ %% In this way a user must select to use a noPassword
+ Passwd =
+ case proplists:get_value(auth_access_password, DirData) of
+ undefined ->
+ ?NOPASSWORD;
+ PassW ->
+ PassW
+ end,
+ DirDataLast = lists:keydelete(auth_access_password,1,DirData),
+ Server_root = proplists:get_value(server_root, ConfigList),
+ case catch AuthMod:store_directory_data(Directory,
+ DirDataLast,
+ Server_root) of
+ ok ->
+ add_auth_password(Directory, Passwd, ConfigList),
+ {ok, {directory, {Directory, DirDataLast}}};
+ {ok, NewDirData} ->
+ add_auth_password(Directory, Passwd, ConfigList),
+ {ok, {directory, {Directory, NewDirData}}};
+ {error, Reason} ->
+ {error, Reason};
+ Other ->
+ {error, Other}
+ end
+ end.
+
+add_auth_password(Dir, Pwd0, ConfigList) ->
+ Addr = proplists:get_value(bind_address, ConfigList),
+ Port = proplists:get_value(port, ConfigList),
+ 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 is_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)
+ 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 proplists:get_value(port, Opt, undefined) of
+ Port when is_integer(Port) ->
+ case proplists:get_value(dir, Opt, undefined) of
+ Dir when is_list(Dir) ->
+ Addr = proplists:get_value(addr, Opt,
+ undefined),
+ AuthPwd = proplists:get_value(authPassword, Opt,
+ ?NOPASSWORD),
+ {Addr, Port, Dir, AuthPwd};
+ _->
+ {error, bad_dir}
+ end;
+ _ ->
+ {error, bad_dir}
+ end;
+
+%% FunctionSpecificData = {userData, UserData} | {password, Password}
+get_options(Opt, userData)->
+ case proplists:get_value(userData, Opt, undefined) of
+ undefined ->
+ {error, no_userdata};
+ UserData ->
+ case proplists:get_value(password, Opt, undefined) of
+ undefined->
+ {error, no_password};
+ Pwd ->
+ {UserData, Pwd}
+ end
+ end.
+
+
+lookup(Db, Key) ->
+ ets:lookup(Db, Key).
diff --git a/lib/inets/src/http_server/mod_auth.hrl b/lib/inets/src/http_server/mod_auth.hrl
new file mode 100644
index 0000000000..9b316cecc4
--- /dev/null
+++ b/lib/inets/src/http_server/mod_auth.hrl
@@ -0,0 +1,29 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-record(httpd_user,
+ {username,
+ password,
+ user_data}).
+
+-record(httpd_group,
+ {name,
+ userlist}).
+
diff --git a/lib/inets/src/http_server/mod_auth_dets.erl b/lib/inets/src/http_server/mod_auth_dets.erl
new file mode 100644
index 0000000000..bc6c2b70a0
--- /dev/null
+++ b/lib/inets/src/http_server/mod_auth_dets.erl
@@ -0,0 +1,254 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-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/3]).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+store_directory_data(_Directory, DirData, Server_root) ->
+ ?CDEBUG("store_directory_data -> ~n"
+ " Directory: ~p~n"
+ " DirData: ~p",
+ [_Directory, DirData]),
+
+ {PWFile, Absolute_pwdfile} = absolute_file_name(auth_user_file, DirData,
+ Server_root),
+ {GroupFile, Absolute_groupfile} = absolute_file_name(auth_group_file,
+ DirData, Server_root),
+ Addr = proplists:get_value(bind_address, DirData),
+ Port = proplists:get_value(port, DirData),
+
+ PWName = httpd_util:make_name("httpd_dets_pwdb",Addr,Port),
+ case dets:open_file(PWName,[{type,set},{file,Absolute_pwdfile},{repair,true}]) of
+ {ok, PWDB} ->
+ GDBName = httpd_util:make_name("httpd_dets_groupdb",Addr,Port),
+ case dets:open_file(GDBName,[{type,set},{file,Absolute_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 = proplists:get_value(auth_user_file, DirData),
+ 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 = proplists:get_value(auth_user_file, DirData),
+ User = {UserName, Addr, Port, Dir},
+ case dets:lookup(PWDB, User) of
+ [{User, Password, UserData}] ->
+ {ok, #httpd_user{username=UserName, password=Password, user_data=UserData}};
+ _ ->
+ {error, no_such_user}
+ end.
+
+list_users(DirData) ->
+ ?DEBUG("list_users -> ~n"
+ " DirData: ~p", [DirData]),
+ {Addr, Port, Dir} = lookup_common(DirData),
+ PWDB = proplists:get_value(auth_user_file, DirData),
+ case dets:traverse(PWDB, fun(X) -> {continue, X} end) of %% SOOOO Ugly !
+ Records when is_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 = proplists:get_value(auth_user_file, DirData),
+ User = {UserName, Addr, Port, Dir},
+ case dets:lookup(PWDB, User) of
+ [{User, _SomePassword, _UserData}] ->
+ dets:delete(PWDB, User),
+ {ok, Groups} = list_groups(DirData),
+ lists:foreach(fun(Group) ->
+ delete_group_member(DirData,
+ Group, UserName) end,
+ Groups),
+ 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 = proplists:get_value(auth_group_file, DirData),
+ 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 = proplists:get_value(auth_group_file, DirData),
+ Group = {GroupName, Addr, Port, Dir},
+ case dets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ {ok, Users};
+ _ ->
+ {error, no_such_group}
+ end.
+
+list_groups(DirData) ->
+ {Addr, Port, Dir} = lookup_common(DirData),
+ GDB = proplists:get_value(auth_group_file, DirData),
+ case dets:match(GDB, {'$1', '_'}) of
+ [] ->
+ {ok, []};
+ List when is_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 = proplists:get_value(auth_group_file, DirData),
+ 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 = proplists:get_value(auth_group_file, DirData),
+ 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 = proplists:get_value(path, DirData),
+ Port = proplists:get_value(port, DirData),
+ Addr = proplists:get_value(bind_address, DirData),
+ {Addr, Port, Dir}.
+
+%% remove/1
+%%
+%% Closes dets tables used by this auth mod.
+%%
+remove(DirData) ->
+ PWDB = proplists:get_value(auth_user_file, DirData),
+ GDB = proplists:get_value(auth_group_file, DirData),
+ dets:close(GDB),
+ dets:close(PWDB),
+ ok.
+
+%% absolute_file_name/2
+%%
+%% Return the absolute path name of File_type.
+absolute_file_name(File_type, DirData, Server_root) ->
+ Path = proplists:get_value(File_type, DirData),
+ Absolute_path = case filename:pathtype(Path) of
+ relative ->
+ case Server_root of
+ undefined ->
+ {error,
+ ?NICE(Path++
+ " is an invalid file name because "
+ "ServerRoot is not defined")};
+ _ ->
+ filename:join(Server_root,Path)
+ end;
+ _ ->
+ Path
+ end,
+ {Path, Absolute_path}.
+
diff --git a/lib/inets/src/http_server/mod_auth_mnesia.erl b/lib/inets/src/http_server/mod_auth_mnesia.erl
new file mode 100644
index 0000000000..ffe028617b
--- /dev/null
+++ b/lib/inets/src/http_server/mod_auth_mnesia.erl
@@ -0,0 +1,284 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-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/3]).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+
+
+store_directory_data(_Directory, _DirData, _Server_root) ->
+ %% We don't need to do anything here, we could of course 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 is_record(Record, httpd_user) ->
+ {ok, Record#httpd_user{username=UserName}};
+ _ ->
+ {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 = proplists:get_value(path, DirData),
+ Port = proplists:get_value(port, DirData),
+ Addr = proplists:get_value(bind_address, DirData),
+ {Addr, Port, Dir}.
+
+
+
+
+
+
+
diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl
new file mode 100644
index 0000000000..d88859d28a
--- /dev/null
+++ b/lib/inets/src/http_server/mod_auth_plain.erl
@@ -0,0 +1,325 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_auth_plain).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+-include("httpd_internal.hrl").
+
+-define(VMODULE,"AUTH_PLAIN").
+
+%% Internal API
+-export([store_directory_data/3]).
+
+
+-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) ->
+ ?hdrt("add user", [{user, UStruct}]),
+ PWDB = proplists:get_value(auth_user_file, DirData),
+ 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) ->
+ ?hdrt("get user", [{dir_data, DirData}, {user, User}]),
+ PWDB = proplists:get_value(auth_user_file, DirData),
+ case ets:lookup(PWDB, User) of
+ [{User, PassWd, Data}] ->
+ {ok, #httpd_user{username = User,
+ password = PassWd,
+ user_data = Data}};
+ _Other ->
+ {error, no_such_user}
+ end.
+
+list_users(DirData) ->
+ PWDB = proplists:get_value(auth_user_file, DirData),
+ Records = ets:match(PWDB, '$1'),
+ {ok, lists:foldr(fun({User, _PassWd, _Data}, A) -> [User | A] end,
+ [], lists:flatten(Records))}.
+
+delete_user(DirData, UserName) ->
+ ?hdrt("delete user", [{dir_data, DirData}, {user, UserName}]),
+ PWDB = proplists:get_value(auth_user_file, DirData),
+ case ets:lookup(PWDB, UserName) of
+ [{UserName, _SomePassword, _SomeData}] ->
+ ets:delete(PWDB, UserName),
+ {ok, Groups} = list_groups(DirData),
+ lists:foreach(fun(Group) ->
+ delete_group_member(DirData,
+ Group, UserName)
+ end, Groups);
+ _ ->
+ {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) ->
+ GDB = proplists:get_value(auth_group_file, DirData),
+ case ets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ case lists:member(UserName, Users) of
+ true ->
+ true;
+ false ->
+ ets:insert(GDB, {Group, [UserName|Users]}),
+ true
+ end;
+ [] ->
+ ets:insert(GDB, {Group, [UserName]}),
+ true;
+ Other ->
+ {error, Other}
+ end.
+
+list_group_members(DirData, Group) ->
+ GDB = proplists:get_value(auth_group_file, DirData),
+ case ets:lookup(GDB, Group) of
+ [{Group, Users}] ->
+ {ok, Users};
+ _ ->
+ {error, no_such_group}
+ end.
+
+list_groups(DirData) ->
+ GDB = proplists:get_value(auth_group_file, DirData),
+ Groups = ets:match(GDB, '$1'),
+ {ok, httpd_util:uniq(lists:foldr(fun({G, _}, A) -> [G|A] end,
+ [], lists:flatten(Groups)))}.
+
+delete_group_member(DirData, Group, User) ->
+ GDB = proplists:get_value(auth_group_file, DirData),
+ case ets:lookup(GDB, Group) of
+ [{Group, Users}] when is_list(Users) ->
+ case lists:member(User, Users) of
+ true ->
+ ets:delete(GDB, Group),
+ ets:insert(GDB, {Group, lists:delete(User, Users)}),
+ true;
+ false ->
+ {error, no_such_group_member}
+ end;
+ _ ->
+ {error, no_such_group}
+ end.
+
+delete_group(DirData, Group) ->
+ GDB = proplists:get_value(auth_group_file, DirData),
+ case ets:lookup(GDB, Group) of
+ [{Group, _Users}] ->
+ ets:delete(GDB, Group),
+ true;
+ _ ->
+ {error, no_such_group}
+ end.
+
+store_directory_data(_Directory, DirData, Server_root) ->
+ ?hdrt("store directory data",
+ [{dir_data, DirData}, {server_root, Server_root}]),
+ PWFile = absolute_file_name(auth_user_file, DirData, Server_root),
+ GroupFile = absolute_file_name(auth_group_file, DirData, Server_root),
+ case load_passwd(PWFile) of
+ {ok, PWDB} ->
+ ?hdrt("password file loaded", [{file, PWFile}, {pwdb, PWDB}]),
+ case load_group(GroupFile) of
+ {ok, GRDB} ->
+ ?hdrt("group file loaded",
+ [{file, GroupFile}, {grdb, GRDB}]),
+ %% Address and port is included in the file names...
+ Addr = proplists:get_value(bind_address, DirData),
+ Port = proplists:get_value(port, DirData),
+ {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, Err}
+ end;
+ 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 inets_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 inets_regexp:split(Line, ":") of
+ {ok, [Group,Users]} ->
+ {ok, UserList} = inets_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 = proplists:get_value(auth_user_file, DirData),
+ GDB = proplists:get_value(auth_group_file, DirData),
+ ets:delete(PWDB),
+ ets:delete(GDB).
+
+
+
+%% absolute_file_name/2
+%%
+%% Return the absolute path name of File_type.
+absolute_file_name(File_type, DirData, Server_root) ->
+ Path = proplists:get_value(File_type, DirData),
+ case filename:pathtype(Path) of
+ relative ->
+ case Server_root of
+ undefined ->
+ {error,
+ ?NICE(Path++
+ " is an invalid file name because "
+ "ServerRoot is not defined")};
+ _ ->
+ filename:join(Server_root,Path)
+ end;
+ _ ->
+ Path
+ end.
+
diff --git a/lib/inets/src/http_server/mod_auth_server.erl b/lib/inets/src/http_server/mod_auth_server.erl
new file mode 100644
index 0000000000..5f9e59be9d
--- /dev/null
+++ b/lib/inets/src/http_server/mod_auth_server.erl
@@ -0,0 +1,400 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(mod_auth_server).
+
+-include("httpd.hrl").
+-include("httpd_internal.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]).
+
+%% gen_server exports
+-export([start_link/2, 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) ->
+ ?hdrt("start_link", [{address, Addr}, {port, Port}]),
+ Name = make_name(Addr, Port),
+ gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]).
+
+
+%% start/2
+
+start(Addr, Port) ->
+ ?hdrd("start", [{address, Addr}, {port, Port}]),
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined ->
+ httpd_misc_sup:start_auth_server(Addr, Port);
+ _ -> %% Already started...
+ ok
+ end.
+
+
+%% stop/2
+
+stop(Addr, Port) ->
+ ?hdrd("stop", [{address, Addr}, {port, Port}]),
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined -> %% Already stopped
+ ok;
+ _ ->
+ (catch httpd_misc_sup:stop_auth_server(Addr, Port))
+ end.
+
+%% add_password/4
+
+add_password(Addr, Port, Dir, Password) ->
+ ?hdrt("add password", [{address, Addr}, {port, Port}]),
+ Name = make_name(Addr, Port),
+ Req = {add_password, Dir, Password},
+ call(Name, Req).
+
+
+%% update_password/6
+
+update_password(Addr, Port, Dir, Old, New) when is_list(New) ->
+ ?hdrt("update password",
+ [{address, Addr}, {port, Port}, {dir, Dir}, {old, Old}, {new, 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) ->
+ ?hdrt("add user",
+ [{address, Addr}, {port, Port},
+ {dir, Dir}, {user, User}, {passwd, 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) ->
+ ?hdrt("delete user",
+ [{address, Addr}, {port, Port},
+ {dir, Dir}, {user, UserName}, {passwd, 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) ->
+ ?hdrt("get user",
+ [{address, Addr}, {port, Port},
+ {dir, Dir}, {user, UserName}, {passwd, 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) ->
+ ?hdrt("list users",
+ [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, 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) ->
+ ?hdrt("add group member",
+ [{address, Addr}, {port, Port}, {dir, Dir},
+ {group, GroupName}, {user, UserName}, {passwd, 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) ->
+ ?hdrt("delete group member",
+ [{address, Addr}, {port, Port}, {dir, Dir},
+ {group, GroupName}, {user, UserName}, {passwd, 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) ->
+ ?hdrt("list group members",
+ [{address, Addr}, {port, Port}, {dir, Dir},
+ {group, Group}, {passwd, 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) ->
+ ?hdrt("delete group",
+ [{address, Addr}, {port, Port}, {dir, Dir},
+ {group, GroupName}, {passwd, 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) ->
+ ?hdrt("list groups",
+ [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]),
+ Name = make_name(Addr, Port),
+ Req = {list_groups, Addr, Port, Dir, Password},
+ call(Name, Req).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Server call-back functions %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% init
+
+init(_) ->
+ ?hdrv("initiating", []),
+ {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),
+ ?hdrt("add user", [{reply, Reply}]),
+ {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 is_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_info(_Info, State) ->
+ {noreply, State}.
+
+handle_cast(_Request, State) ->
+ {noreply, State}.
+
+
+terminate(_Reason,State) ->
+ ets:delete(State#state.tab),
+ ok.
+
+
+%% code_change(Vsn, State, Extra)
+%%
+code_change(_Vsn, State, _Extra) ->
+ {ok, State}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% 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),
+ (catch apply(AuthMod, Func, [DirData|Args]));
+ _ ->
+ {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 is_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 is_binary(PwdExists) ->
+ {error, dir_protected};
+ {error, _} ->
+ do_update_password(Dir, Password, State)
+ end.
+
+
+auth_mod_name(DirData) ->
+ case proplists:get_value(auth_type, DirData, 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/inets/src/http_server/mod_browser.erl b/lib/inets/src/http_server/mod_browser.erl
new file mode 100644
index 0000000000..1c9b33dffa
--- /dev/null
+++ b/lib/inets/src/http_server/mod_browser.erl
@@ -0,0 +1,249 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% ----------------------------------------------------------------------
+%%
+%% 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
+%% some axamples:
+%%
+%% Netscape Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u)
+%% Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
+%% Mozilla Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020827
+%% Safari Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85 (KHTML, like Gecko) Safari/85
+%% 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).
+
+-export([do/1, test/0, getBrowser/1]).
+
+%% 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,[{netscape, "netscape"},
+ {opera, "opera"},
+ {msie, "msie"},
+ {safari, "safari"},
+ {mozilla, "rv:"}]). % fallback, must be last
+
+
+%% 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"]},
+ {macosx, ["mac os x"]}]).
+
+-define(LYNX, lynx).
+-define(MOZILLA, mozilla).
+-define(EMACS, emacs).
+-define(STAROFFICE, soffice).
+-define(MOSAIC, mosaic).
+-define(NETSCAPE, netscape).
+-define(SAFARU, safari).
+-define(UNKOWN, unknown).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"BROWSER").
+
+do(Info) ->
+ case proplists:get_value(status, Info#mod.data) of
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ undefined ->
+ Browser = getBrowser1(Info),
+ {proceed,[{'user-agent', Browser}|Info#mod.data]}
+ end.
+
+getBrowser1(Info) ->
+ PHead = Info#mod.parsed_header,
+ case proplists:get_value("user-agent", PHead) of
+ undefined ->
+ undefined;
+ AgentString ->
+ getBrowser(AgentString)
+ end.
+
+getBrowser(AgentString) ->
+ LAgentString = http_util:to_lower(AgentString),
+ case inets_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([$s,$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 is_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 inets_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
+%% are not the default mozillaborwser against the regexp
+%% for the different browsers. if no match, it is a mozilla
+%% browser i.e opera, netscape, ie or safari
+
+getMozilla(_AgentString,[],Default) ->
+ Default;
+getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) ->
+ case inets_regexp:match(AgentString,AgentRegExp) of
+ {match,_,_} ->
+ {Agent,getMozVersion(AgentString,AgentRegExp)};
+ nomatch ->
+ getMozilla(AgentString,Rest,Default)
+ end.
+
+getMozVersion(AgentString, AgentRegExp) ->
+ case inets_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
+ case strip(VsnString) of
+ [] ->
+ unknown;
+ [Y1,Y2,Y3,Y4,M1,M2,D1,D2] = DateVsn when
+ Y1 =< $9, Y1 >= $0,
+ Y2 =< $9, Y2 >= $0,
+ Y3 =< $9, Y3 >= $0,
+ Y4 =< $9, Y4 >= $0,
+ M1 =< $9, M1 >= $0,
+ M2 =< $9, M2 >= $0,
+ D1 =< $9, D1 >= $0,
+ D2 =< $9, D2 >= $0 ->
+ list_to_integer(DateVsn);
+ Vsn ->
+ case string:tokens(Vsn,".") of
+ [Number]->
+ list_to_float(Number++".0");
+ [Major,Minor|Rev] ->
+ V = lists:flatten([Major,".",Minor,Rev]),
+ list_to_float(V)
+ end
+ end;
+ nomatch ->
+ unknown
+ end.
+
+strip(VsnString) ->
+ strip2(strip1(VsnString)).
+
+strip1(VsnString) ->
+ string:strip(VsnString,both,$\ ).
+
+strip2(VsnString) ->
+ string:strip(VsnString,both,$/ ).
+
+test()->
+ test("Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u)"),
+ test("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0"),
+ test("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020827"),
+ test("Mozilla/5.0 (Macintosh; U; PPC Mac OS X Mach-O; en-US; rv:1.4) Gecko/20020827"),
+ test("Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85 (KHTML, like Gecko) Safari/85"),
+ test("Mozilla/4.0 (compatible; MSIE 5.0; SP1B; SunOS 5.8 sun4u; X11)"),
+ test("Lynx/2.8.3rel.1 libwww-FM/2.142"),
+ ok.
+
+test(Str) ->
+ Browser = getBrowser(Str),
+ io:format("~n--------------------------------------------------------~n"),
+ io:format("~p",[Browser]),
+ io:format("~n--------------------------------------------------------~n").
+
diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl
new file mode 100644
index 0000000000..ab12a3b57b
--- /dev/null
+++ b/lib/inets/src/http_server/mod_cgi.erl
@@ -0,0 +1,350 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% Implements The WWW Common Gateway Interface Version 1.1
+
+-module(mod_cgi).
+
+-export([env/3]).
+
+%%% Callback API
+-export([do/1, load/2, store/2]).
+
+-include("http_internal.hrl").
+-include("httpd.hrl").
+
+-define(VMODULE,"CGI").
+
+-define(DEFAULT_CGI_TIMEOUT, 15000).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% do(ModData, _, AfterScript) -> [{EnvVariable, Value}]
+%%
+%% AfterScript = string()
+%% ModData = #mod{}
+%% EnvVariable = string()
+%% Value = term()
+%% Description: Keep for now as it is documented in the man page
+%%-------------------------------------------------------------------------
+env(ModData, _Script, AfterScript) ->
+ ScriptElements = script_elements(ModData, AfterScript),
+ httpd_script_env:create_env(cgi, ModData, ScriptElements).
+
+%%%=========================================================================
+%%% Callback API
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% do(ModData) -> {proceed, OldData} | {proceed, NewData} | {break, NewData}
+%% | done
+%% ModData = #mod{}
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+do(ModData) ->
+ case proplists:get_value(status, ModData#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed, ModData#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, ModData#mod.data) of
+ undefined ->
+ generate_response(ModData);
+ _Response ->
+ {proceed, ModData#mod.data}
+ end
+ end.
+
+%%--------------------------------------------------------------------------
+%% load(Line, Context) -> eof | ok | {ok, NewContext} |
+%% {ok, NewContext, Directive} |
+%% {ok, NewContext, DirectiveList} | {error, Reason}
+%% Line = string()
+%% Context = NewContext = DirectiveList = [Directive]
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+
+%% ScriptNoCache true|false, defines whether the server shall add
+%% header fields to stop proxies and
+%% clients from saving the page in history
+%% or cache
+%%
+load("ScriptNoCache " ++ 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;
+%% ScriptTimeout Seconds, The number of seconds that the server
+%% maximum will wait for the script to
+%% generate a part of the document
+load("ScriptTimeout " ++ Timeout, [])->
+ case catch list_to_integer(httpd_conf:clean(Timeout)) of
+ TimeoutSec when is_integer(TimeoutSec) ->
+ {ok, [], {script_timeout,TimeoutSec*1000}};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(Timeout)++
+ " is an invalid ScriptTimeout")}
+ end.
+
+%%--------------------------------------------------------------------------
+%% store(Directive, DirectiveList) -> {ok, NewDirective} |
+%% {ok, [NewDirective]} |
+%% {error, Reason}
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+store({script_nocache, Value} = Conf, _)
+ when Value == true; Value == false ->
+ {ok, Conf};
+store({script_nocache, Value}, _) ->
+ {error, {wrong_type, {script_nocache, Value}}};
+store({script_timeout, Value} = Conf, _)
+ when is_integer(Value), Value >= 0 ->
+ {ok, Conf};
+store({script_timeout, Value}, _) ->
+ {error, {wrong_type, {script_timeout, Value}}}.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+generate_response(ModData) ->
+ RequestURI =
+ case proplists:get_value(new_request_uri, ModData#mod.data) of
+ undefined ->
+ ModData#mod.request_uri;
+ Value ->
+ Value
+ end,
+ ScriptAliases =
+ httpd_util:multi_lookup(ModData#mod.config_db, script_alias),
+ case mod_alias:real_script_name(ModData#mod.config_db, RequestURI,
+ ScriptAliases) of
+ {Script, AfterScript} ->
+ exec_script(ModData, Script, AfterScript,
+ RequestURI);
+ not_a_script ->
+ {proceed, ModData#mod.data}
+ end.
+
+is_executable(File) ->
+ Dir = filename:dirname(File),
+ FileName = filename:basename(File),
+ case os:type() of
+ {win32,_} ->
+ %% temporary (hopefully) fix for win32 OTP-3627
+ is_win32_executable(Dir,FileName);
+ _ ->
+ is_executable(Dir, FileName)
+ end.
+
+is_executable(Dir, FilName) ->
+ case os:find_executable(FilName, Dir) of
+ false ->
+ false;
+ _ ->
+ true
+ end.
+
+%% Start temporary (hopefully) fix for win32 OTP-3627
+%% ---------------------------------
+is_win32_executable(Dir, FileName) ->
+ NewFileName = strip_extention(FileName, [".bat",".exe",".com", ".cmd"]),
+ is_executable(Dir, NewFileName).
+
+strip_extention(FileName, []) ->
+ FileName;
+strip_extention(FileName, [Extention | Extentions]) ->
+ case filename:basename(FileName, Extention) of
+ FileName ->
+ strip_extention(FileName, Extentions);
+ NewFileName ->
+ NewFileName
+ end.
+
+%% End fix
+%% ---------------------------------
+
+exec_script(ModData, Script, AfterScript, RequestURI) ->
+ exec_script(is_executable(Script), ModData, Script,
+ AfterScript, RequestURI).
+
+exec_script(true, ModData, Script, AfterScript, _RequestURI) ->
+ process_flag(trap_exit,true),
+ Dir = filename:dirname(Script),
+ ScriptElements = script_elements(ModData, AfterScript),
+ Env = (catch httpd_script_env:create_env(cgi, ModData, ScriptElements)),
+
+ %% Run script
+ Port = (catch open_port({spawn, Script},[binary, stream,
+ {cd, Dir}, {env, Env}])),
+ case Port of
+ Port when is_port(Port) ->
+ send_request_body_to_script(ModData, Port),
+ deliver_webpage(ModData, Port); % Take care of script output
+ Error ->
+ exit({open_port_failed, Error,
+ [{mod,?MODULE},
+ {uri,ModData#mod.request_uri}, {script,Script},
+ {env,Env},{dir,Dir}]})
+ end;
+
+exec_script(false, ModData, _Script, _AfterScript, _RequestURI) ->
+ {proceed,
+ [{status,
+ {404,ModData#mod.request_uri,
+ ?NICE("You don't have permission to execute " ++
+ ModData#mod.request_uri ++ " on this server")}}|
+ ModData#mod.data]}.
+
+send_request_body_to_script(ModData, Port) ->
+ case ModData#mod.entity_body of
+ [] ->
+ ok;
+ EntityBody ->
+ port_command(Port, EntityBody)
+ end.
+
+deliver_webpage(#mod{config_db = Db} = ModData, Port) ->
+ Timeout = cgi_timeout(Db),
+ case receive_headers(Port, httpd_cgi, parse_headers,
+ [<<>>, [], []], Timeout) of
+ {Headers, Body} ->
+ case httpd_cgi:handle_headers(Headers) of
+ {proceed, AbsPath} ->
+ {proceed, [{real_name,
+ httpd_util:split_path(AbsPath)} |
+ ModData#mod.data]};
+ {ok, HTTPHeaders, Status} ->
+ IsDisableChunkedSend =
+ httpd_response:is_disable_chunked_send(Db),
+ case (ModData#mod.http_version =/= "HTTP/1.1") or
+ (IsDisableChunkedSend) of
+ true ->
+ send_headers(ModData, Status,
+ [{"connection", "close"}
+ | HTTPHeaders]);
+ false ->
+ send_headers(ModData, Status,
+ [{"transfer-encoding",
+ "chunked"} | HTTPHeaders])
+ end,
+ handle_body(Port, ModData, Body, Timeout, size(Body),
+ IsDisableChunkedSend)
+ end;
+ {'EXIT', Port, Reason} ->
+ process_flag(trap_exit, false),
+ {proceed, [{status, {400, none, reason(Reason)}} |
+ ModData#mod.data]};
+ timeout ->
+ (catch port_close(Port)), % KILL the port !!!!
+ send_headers(ModData, {504, "Timeout"}, []),
+ httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket),
+ process_flag(trap_exit,false),
+ {proceed,[{response, {already_sent, 200, 0}} | ModData#mod.data]}
+ end.
+
+receive_headers(Port, Module, Function, Args, Timeout) ->
+ receive
+ {Port, {data, Response}} when is_port(Port) ->
+ case Module:Function([Response | Args]) of
+ {NewModule, NewFunction, NewArgs} ->
+ receive_headers(Port, NewModule,
+ NewFunction, NewArgs, Timeout);
+ {ok, {Headers, Body}} ->
+ {Headers, Body}
+ end;
+ {'EXIT', Port, Reason} when is_port(Port) ->
+ {'EXIT', Port, Reason};
+ {'EXIT', Pid, Reason} when is_pid(Pid) ->
+ exit({linked_process_died, Pid, Reason})
+ after Timeout ->
+ timeout
+ end.
+
+send_headers(ModData, {StatusCode, _}, HTTPHeaders) ->
+ ExtraHeaders = httpd_response:cache_headers(ModData),
+ httpd_response:send_header(ModData, StatusCode,
+ ExtraHeaders ++ HTTPHeaders).
+
+handle_body(Port, #mod{method = "HEAD"} = ModData, _, _, Size, _) ->
+ (catch port_close(Port)), % KILL the port !!!!
+ process_flag(trap_exit,false),
+ {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]};
+
+handle_body(Port, ModData, Body, Timeout, Size, IsDisableChunkedSend) ->
+ httpd_response:send_chunk(ModData, Body, IsDisableChunkedSend),
+ receive
+ {Port, {data, Data}} when is_port(Port) ->
+ handle_body(Port, ModData, Data, Timeout, Size + size(Data),
+ IsDisableChunkedSend);
+ {'EXIT', Port, normal} when is_port(Port) ->
+ httpd_response:send_final_chunk(ModData, IsDisableChunkedSend),
+ process_flag(trap_exit,false),
+ {proceed, [{response, {already_sent, 200, Size}} |
+ ModData#mod.data]};
+ {'EXIT', Port, Reason} when is_port(Port) ->
+ process_flag(trap_exit, false),
+ {proceed, [{status, {400, none, reason(Reason)}} |
+ ModData#mod.data]};
+ {'EXIT', Pid, Reason} when is_pid(Pid) ->
+ exit({mod_cgi_linked_process_died, Pid, Reason})
+ after Timeout ->
+ (catch port_close(Port)), % KILL the port !!!!
+ process_flag(trap_exit,false),
+ {proceed,[{response, {already_sent, 200, Size}} |
+ ModData#mod.data]}
+ end.
+
+script_elements(#mod{method = "GET"}, {[], QueryString}) ->
+ [{query_string, QueryString}];
+script_elements(#mod{method = "GET"}, {PathInfo, []}) ->
+ [{path_info, PathInfo}];
+script_elements(#mod{method = "GET"}, {PathInfo, QueryString}) ->
+ [{query_string, QueryString}, {path_info, PathInfo}];
+script_elements(#mod{method = "POST", entity_body = Body}, _) ->
+ [{entity_body, Body}];
+script_elements(_, _) ->
+ [].
+
+cgi_timeout(Db) ->
+ httpd_util:lookup(Db, cgi_timeout, ?DEFAULT_CGI_TIMEOUT).
+
+%% 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(Reason) -> lists:flatten(io_lib:format("Reason: ~p~n", [Reason])).
diff --git a/lib/inets/src/http_server/mod_dir.erl b/lib/inets/src/http_server/mod_dir.erl
new file mode 100644
index 0000000000..cdc7cc01e4
--- /dev/null
+++ b/lib/inets/src/http_server/mod_dir.erl
@@ -0,0 +1,284 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_dir).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ case Info#mod.method of
+ "GET" ->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) 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} ->
+ LastModified =
+ case (catch httpd_util:rfc1123_date(
+ FileInfo#file_info.mtime)) of
+ Date when is_list(Date) ->
+ [{"date", Date}];
+ _ -> %% This will rarly happen, but could happen
+ %% if a computer is wrongly configured.
+ []
+ end,
+ Head=[{content_type,"text/html"},
+ {content_length,
+ integer_to_list(httpd_util:flatlength(Dir))},
+ {code,200} | LastModified],
+ {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]),
+ Status = httpd_file:handle_error(Reason, "access", Info,
+ DefaultPath),
+ {proceed, [{status, Status}| 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++": "++
+ file:format_error(Reason))}
+ end.
+
+%% header
+
+header(Path,RequestURI) ->
+ Header = "<HTML>\n<HEAD>\n<TITLE>Index of "++ RequestURI ++
+ "</TITLE>\n</HEAD>\n<BODY>\n<H1>Index of "++
+ RequestURI ++ "</H1>\n<PRE><IMG SRC=\"" ++ icon(blank) ++
+ "\" ALT=" "> Name Last modified "
+ "Size Description <HR>\n",
+ case inets_regexp:sub(RequestURI,"[^/]*\$","") of
+ {ok,"/",_} ->
+ Header;
+ {ok,ParentRequestURI,_} ->
+ {ok,ParentPath,_} =
+ inets_regexp:sub(string:strip(Path,right,$/),"[^/]*\$",""),
+ Header++format(ParentPath,ParentRequestURI)
+ end.
+
+format(Path,RequestURI) ->
+ {ok,FileInfo}=file:read_file_info(Path),
+ {{Year, Month, Day},{Hour, Minute, _Second}} = FileInfo#file_info.mtime,
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\">"
+ " <A HREF=\"~s\">Parent directory</A> "
+ " ~2.2.0w-~s-~w ~2.2.0w:~2.2.0w -\n",
+ [icon(back),"DIR",RequestURI,Day,
+ httpd_util:month(Month),Year,Hour,Minute]).
+
+%% body
+
+body(_Path, _RequestURI, _ConfigDB, []) ->
+ [];
+body(Path, RequestURI, ConfigDB, [Entry | Rest]) ->
+ [format(Path, RequestURI, ConfigDB, Entry)|
+ body(Path, RequestURI, ConfigDB, Rest)].
+
+format(Path,RequestURI,ConfigDB,Entry) ->
+ case file:read_file_info(Path++"/"++Entry) of
+ {ok,FileInfo} when FileInfo#file_info.type == directory ->
+ {{Year, Month, Day},{Hour, Minute, _Second}} =
+ FileInfo#file_info.mtime,
+ EntryLength=length(Entry),
+ if
+ EntryLength > 21 ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> "
+ "<A HREF=\"~s\">~-21.s..</A>"
+ "~2.2.0w-~s-~w ~2.2.0w:~2.2.0w"
+ " -\n", [icon(folder),"DIR",
+ RequestURI++"/"++Entry++"/",
+ Entry,
+ Day, httpd_util:month(Month),
+ Year,Hour,Minute]);
+ true ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\">"
+ " <A HREF=\"~s\">~s</A>~*.*c~2.2.0"
+ "w-~s-~w ~2.2.0w:~2.2.0w -\n",
+ [icon(folder),"DIR",RequestURI ++ "/" ++
+ Entry ++ "/",Entry,
+ 23-EntryLength,23-EntryLength,$ ,Day,
+ httpd_util:month(Month),Year,Hour,Minute])
+ end;
+ {ok,FileInfo} ->
+ {{Year, Month, Day},{Hour, Minute,_Second}} =
+ FileInfo#file_info.mtime,
+ Suffix=httpd_util:suffix(Entry),
+ MimeType=httpd_util:lookup_mime(ConfigDB,Suffix,""),
+ EntryLength=length(Entry),
+ if
+ EntryLength > 21 ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\">"
+ " <A HREF=\"~s\">~-21.s..</A>~2.2.0"
+ "w-~s-~w ~2.2.0w:~2.2.0w~8wk ~s\n",
+ [icon(Suffix, MimeType), Suffix, RequestURI
+ ++"/"++Entry, Entry,Day,
+ httpd_util:month(Month),Year,Hour,Minute,
+ trunc(FileInfo#file_info.size/1024+1),
+ MimeType]);
+ true ->
+ io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> "
+ "<A HREF=\"~s\">~s</A>~*.*c~2.2.0w-~s-~w"
+ " ~2.2.0w:~2.2.0w~8wk ~s\n",
+ [icon(Suffix, MimeType), Suffix, RequestURI
+ ++ "/" ++ Entry, Entry, 23-EntryLength,
+ 23-EntryLength, $ ,Day,
+ httpd_util:month(Month),Year,Hour,Minute,
+ trunc(FileInfo#file_info.size/1024+1),
+ MimeType])
+ end;
+ {error, _Reason} ->
+ ""
+ end.
+
+%% footer
+
+footer(Path,FileList) ->
+ case lists:member("README",FileList) of
+ true ->
+ {ok,Body}=file:read_file(Path++"/README"),
+ "</PRE>\n<HR>\n<PRE>\n"++binary_to_list(Body)++
+ "\n</PRE>\n</BODY>\n</HTML>\n";
+ false ->
+ "</PRE>\n</BODY>\n</HTML>\n"
+ end.
+
+%%
+%% Icon mappings are hard-wired ala default Apache (Ugly!)
+%%
+
+icon(Suffix,MimeType) ->
+ case icon(Suffix) of
+ undefined ->
+ case MimeType of
+ [$t,$e,$x,$t,$/|_] ->
+ "/icons/text.gif";
+ [$i,$m,$a,$g,$e,$/|_] ->
+ "/icons/image2.gif";
+ [$a,$u,$d,$i,$o,$/|_] ->
+ "/icons/sound2.gif";
+ [$v,$i,$d,$e,$o,$/|_] ->
+ "/icons/movie.gif";
+ _ ->
+ "/icons/unknown.gif"
+ end;
+ Icon ->
+ Icon
+ end.
+
+icon(blank) -> "/icons/blank.gif";
+icon(back) -> "/icons/back.gif";
+icon(folder) -> "/icons/folder.gif";
+icon("bin") -> "/icons/binary.gif";
+icon("exe") -> "/icons/binary.gif";
+icon("hqx") -> "/icons/binhex.gif";
+icon("tar") -> "/icons/tar.gif";
+icon("wrl") -> "/icons/world2.gif";
+icon("wrl.gz") -> "/icons/world2.gif";
+icon("vrml") -> "/icons/world2.gif";
+icon("vrm") -> "/icons/world2.gif";
+icon("iv") -> "/icons/world2.gif";
+icon("Z") -> "/icons/compressed.gif";
+icon("z") -> "/icons/compressed.gif";
+icon("tgz") -> "/icons/compressed.gif";
+icon("gz") -> "/icons/compressed.gif";
+icon("zip") -> "/icons/compressed.gif";
+icon("ps") -> "/icons/a.gif";
+icon("ai") -> "/icons/a.gif";
+icon("eps") -> "/icons/a.gif";
+icon("html") -> "/icons/layout.gif";
+icon("shtml") -> "/icons/layout.gif";
+icon("htm") -> "/icons/layout.gif";
+icon("pdf") -> "/icons/layout.gif";
+icon("txt") -> "/icons/text.gif";
+icon("erl") -> "/icons/burst.gif";
+icon("c") -> "/icons/c.gif";
+icon("pl") -> "/icons/p.gif";
+icon("py") -> "/icons/p.gif";
+icon("for") -> "/icons/f.gif";
+icon("dvi") -> "/icons/dvi.gif";
+icon("uu") -> "/icons/uuencoded.gif";
+icon("conf") -> "/icons/script.gif";
+icon("sh") -> "/icons/script.gif";
+icon("shar") -> "/icons/script.gif";
+icon("csh") -> "/icons/script.gif";
+icon("ksh") -> "/icons/script.gif";
+icon("tcl") -> "/icons/script.gif";
+icon("tex") -> "/icons/tex.gif";
+icon("core") -> "/icons/tex.gif";
+icon(_) -> undefined.
+
+
diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl
new file mode 100644
index 0000000000..95e0d00c70
--- /dev/null
+++ b/lib/inets/src/http_server/mod_disk_log.erl
@@ -0,0 +1,415 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_disk_log).
+
+%% Application internal API
+-export([error_log/2, report_error/2, security_log/2]).
+
+%% Callback API
+-export([do/1, load/2, store/2, remove/1]).
+
+-define(VMODULE,"DISK_LOG").
+
+-include("httpd.hrl").
+
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+%% security_log
+security_log(#mod{config_db = ConfigDb} = Info, Event) ->
+ Format = get_log_format(ConfigDb),
+ Date = httpd_util:custom_date(),
+ case httpd_log:security_entry(security_disk_log, no_security_log,
+ Info, Date, Event) of
+ no_security_log ->
+ ok;
+ {Log, Entry} ->
+ write(Log, Entry, Format)
+ end.
+
+report_error(ConfigDB, Error) ->
+ Format = get_log_format(ConfigDB),
+ Date = httpd_util:custom_date(),
+ case httpd_log:error_report_entry(error_disk_log, no_error_log, ConfigDB,
+ Date, Error) of
+ no_error_log ->
+ ok;
+ {Log, Entry} ->
+ write(Log, Entry, Format)
+ end.
+
+error_log(Info, Reason) ->
+ Date = httpd_util:custom_date(),
+ error_log(Info, Date, Reason).
+
+error_log(#mod{config_db = ConfigDB} = Info, Date, Reason) ->
+ Format = get_log_format(ConfigDB),
+ case httpd_log:error_entry(error_disk_log, no_error_log,
+ Info, Date, Reason) of
+ no_error_log ->
+ ok;
+ {Log, Entry} ->
+ write(Log, Entry, Format)
+ end.
+
+%%%=========================================================================
+%%% CALLBACK API
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% do(ModData) -> {proceed, OldData} | {proceed, NewData} | {break, NewData}
+%% | done
+%% ModData = #mod{}
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+do(Info) ->
+ AuthUser = auth_user(Info#mod.data),
+ Date = httpd_util:custom_date(),
+ log_internal_info(Info,Date,Info#mod.data),
+ LogFormat = get_log_format(Info#mod.config_db),
+ case proplists:get_value(status, Info#mod.data) 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);
+ true ->
+ not_an_error
+ end,
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) of
+ {already_sent,StatusCode,Size} ->
+ transfer_log(Info, "-", AuthUser, Date, StatusCode,
+ Size, LogFormat),
+ {proceed,Info#mod.data};
+
+ {response, Head, _Body} ->
+ Size = proplists:get_value(content_length, Head, 0),
+ Code = proplists:get_value(code, Head, 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.
+
+%%--------------------------------------------------------------------------
+%% load(Line, Context) -> eof | ok | {ok, NewContext} |
+%% {ok, NewContext, Directive} |
+%% {ok, NewContext, DirectiveList} | {error, Reason}
+%% Line = string()
+%% Context = NewContext = DirectiveList = [Directive]
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+load("TransferDiskLogSize " ++ TransferDiskLogSize, []) ->
+ case inets_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("TransferDiskLog " ++ TransferDiskLog,[]) ->
+ {ok,[],{transfer_disk_log,httpd_conf:clean(TransferDiskLog)}};
+
+load("ErrorDiskLogSize " ++ ErrorDiskLogSize, []) ->
+ case inets_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("ErrorDiskLog " ++ ErrorDiskLog, []) ->
+ {ok, [], {error_disk_log, httpd_conf:clean(ErrorDiskLog)}};
+
+load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) ->
+ case inets_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("SecurityDiskLog " ++ SecurityDiskLog, []) ->
+ {ok, [], {security_disk_log, httpd_conf:clean(SecurityDiskLog)}};
+
+load("DiskLogFormat " ++ 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(Directive, DirectiveList) -> {ok, NewDirective} |
+%% {ok, [NewDirective]} |
+%% {error, Reason}
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+store({transfer_disk_log,TransferDiskLog}, ConfigList)
+ when is_list(TransferDiskLog) ->
+ case create_disk_log(TransferDiskLog,
+ transfer_disk_log_size, ConfigList) of
+ {ok,TransferDB} ->
+ {ok,{transfer_disk_log,TransferDB}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({transfer_disk_log,TransferLog}, _) ->
+ {error, {wrong_type, {transfer_disk_log, TransferLog}}};
+store({security_disk_log,SecurityDiskLog},ConfigList)
+ when is_list(SecurityDiskLog) ->
+ case create_disk_log(SecurityDiskLog,
+ security_disk_log_size, ConfigList) of
+ {ok,SecurityDB} ->
+ {ok,{security_disk_log,SecurityDB}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({security_disk_log, SecurityLog}, _) ->
+ {error, {wrong_type, {security_disk_log, SecurityLog}}};
+
+store({error_disk_log,ErrorDiskLog},ConfigList) when is_list(ErrorDiskLog) ->
+ case create_disk_log(ErrorDiskLog, error_disk_log_size, ConfigList) of
+ {ok,ErrorDB} ->
+ {ok,{error_disk_log,ErrorDB}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({error_disk_log,ErrorLog}, _) ->
+ {error, {wrong_type, {error_disk_log, ErrorLog}}};
+store({transfer_disk_log_size, {ByteInt, FileInt}} = Conf, _)
+ when is_integer(ByteInt), is_integer(FileInt)->
+ {ok, Conf};
+store({transfer_disk_log_size, Value}, _) ->
+ {error, {wrong_type, {transfer_disk_log_size, Value}}};
+store({error_disk_log_size, {ByteInt, FileInt}} = Conf, _)
+ when is_integer(ByteInt), is_integer(FileInt)->
+ {ok, Conf};
+store({error_disk_log_size, Value}, _) ->
+ {error, {wrong_type, {error_disk_log_size, Value}}};
+store({security_disk_log_size, {ByteInt, FileInt}} = Conf, _)
+ when is_integer(ByteInt), is_integer(FileInt)->
+ {ok, Conf};
+store({security_disk_log_size, Value}, _) ->
+ {error, {wrong_type, {security_disk_log_size, Value}}};
+store({disk_log_format, Value} = Conf, _) when Value == internal;
+ Value == external ->
+ {ok, Conf};
+store({disk_log_format, Value}, _) ->
+ {error, {wrong_type, {disk_log_format, Value}}}.
+
+%%--------------------------------------------------------------------------
+%% remove(ConfigDb) -> _
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+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'})),
+ lists:foreach(fun([DiskLog]) -> close(DiskLog) end,
+ ets:match(ConfigDB,{security_disk_log,'$1'})),
+ ok.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
+%% transfer_log
+transfer_log(Info, RFC931, AuthUser, Date, StatusCode, Bytes, Format) ->
+ case httpd_log:access_entry(transfer_disk_log, no_transfer_log,
+ Info, RFC931, AuthUser, Date, StatusCode,
+ Bytes) of
+ no_transfer_log ->
+ ok;
+ {Log, Entry} ->
+ write(Log, Entry, Format)
+ end.
+
+
+get_log_format(ConfigDB)->
+ httpd_util:lookup(ConfigDB,disk_log_format,external).
+
+%%----------------------------------------------------------------------
+%% Open or creates the disklogs
+%%----------------------------------------------------------------------
+log_size(ConfigList, Tag) ->
+ proplists:get_value(Tag, ConfigList, {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 proplists:get_value(server_root,ConfigList) 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 = proplists:get_value(disk_log_format, ConfigList, external),
+ open(Filename, MaxBytes, MaxFiles, Format).
+
+
+%%----------------------------------------------------------------------
+%% 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} ->
+ {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, list_to_binary(Entry));
+
+write(Log, Entry, _) ->
+ disk_log:blog(Log, list_to_binary(Entry)).
+
+%% Close the log file
+close(Log) ->
+ disk_log:close(Log).
+
+auth_user(Data) ->
+ case proplists:get_value(remote_user,Data) of
+ undefined ->
+ "-";
+ RemoteUser ->
+ RemoteUser
+ end.
+%% log_internal_info
+
+log_internal_info(_, _,[]) ->
+ 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).
+
diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl
new file mode 100644
index 0000000000..dd6f62ae2d
--- /dev/null
+++ b/lib/inets/src/http_server/mod_esi.erl
@@ -0,0 +1,492 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_esi).
+
+%% API
+%% Functions provided to help erl scheme alias programmer to
+%% Create dynamic webpages that are sent back to the user during
+%% Generation
+-export([deliver/2]).
+
+%% Callback API
+-export([do/1, load/2, store/2]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"ESI").
+-define(DEFAULT_ERL_TIMEOUT,15000).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% deliver(SessionID, Data) -> ok | {error, bad_sessionID}
+%% SessionID = pid()
+%% Data = string() | io_list() (first call must send a string that
+%% contains all header information including "\r\n\r\n", unless there
+%% is no header information at all.)
+%%
+%% Description: Send <Data> (Html page generated sofar) to the server
+%% request handling process so it can forward it to the client.
+%%-------------------------------------------------------------------------
+deliver(SessionID, Data) when is_pid(SessionID) ->
+ SessionID ! {ok, Data},
+ ok;
+deliver(_SessionID, _Data) ->
+ {error, bad_sessionID}.
+
+%%%=========================================================================
+%%% CALLBACK API
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% do(ModData) -> {proceed, OldData} | {proceed, NewData} | {break, NewData}
+%% | done
+%% ModData = #mod{}
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+do(ModData) ->
+ case proplists:get_value(status, ModData#mod.data) of
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed, ModData#mod.data};
+ undefined ->
+ case proplists:get_value(response, ModData#mod.data) of
+ undefined ->
+ generate_response(ModData);
+ _Response ->
+ {proceed, ModData#mod.data}
+ end
+ end.
+%%--------------------------------------------------------------------------
+%% load(Line, Context) -> eof | ok | {ok, NewContext} |
+%% {ok, NewContext, Directive} |
+%% {ok, NewContext, DirectiveList} | {error, Reason}
+%% Line = string()
+%% Context = NewContext = DirectiveList = [Directive]
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+load("ErlScriptAlias " ++ ErlScriptAlias, []) ->
+ case inets_regexp:split(ErlScriptAlias," ") of
+ {ok, [ErlName | StrModules]} ->
+ Modules = lists:map(fun(Str) ->
+ list_to_atom(httpd_conf:clean(Str))
+ end, StrModules),
+ {ok, [], {erl_script_alias, {ErlName, Modules}}};
+ {ok, _} ->
+ {error, ?NICE(httpd_conf:clean(ErlScriptAlias) ++
+ " is an invalid ErlScriptAlias")}
+ end;
+load("EvalScriptAlias " ++ EvalScriptAlias, []) ->
+ case inets_regexp:split(EvalScriptAlias, " ") of
+ {ok, [EvalName | StrModules]} ->
+ Modules = lists:map(fun(Str) ->
+ list_to_atom(httpd_conf:clean(Str))
+ end, StrModules),
+ {ok, [], {eval_script_alias, {EvalName, Modules}}};
+ {ok, _} ->
+ {error, ?NICE(httpd_conf:clean(EvalScriptAlias) ++
+ " is an invalid EvalScriptAlias")}
+ end;
+load("ErlScriptTimeout " ++ Timeout, [])->
+ case catch list_to_integer(httpd_conf:clean(Timeout)) of
+ TimeoutSec when is_integer(TimeoutSec) ->
+ {ok, [], {erl_script_timeout, TimeoutSec * 1000}};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(Timeout) ++
+ " is an invalid ErlScriptTimeout")}
+ end;
+load("ErlScriptNoCache " ++ 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.
+
+%%--------------------------------------------------------------------------
+%% store(Directive, DirectiveList) -> {ok, NewDirective} |
+%% {ok, [NewDirective]} |
+%% {error, Reason}
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+store({erl_script_alias, {Name, [all]}} = Conf, _)
+ when is_list(Name) ->
+ {ok, Conf};
+
+store({erl_script_alias, {Name, Modules}} = Conf, _)
+ when is_list(Name) ->
+ try httpd_util:modules_validate(Modules) of
+ ok ->
+ {ok, Conf}
+ catch
+ throw:Error ->
+ {error, {wrong_type, {erl_script_alias, Error}}}
+ end;
+
+store({eval_script_alias, {Name, Modules}} = Conf, _)
+ when is_list(Name)->
+ try httpd_util:modules_validate(Modules) of
+ ok ->
+ {ok, Conf}
+ catch
+ throw:Error ->
+ {error, {wrong_type, {eval_script_alias, Error}}}
+ end;
+
+store({erl_script_alias, Value}, _) ->
+ {error, {wrong_type, {erl_script_alias, Value}}};
+store({erl_script_timeout, Value} = Conf, _)
+ when is_integer(Value), Value >= 0 ->
+ {ok, Conf};
+store({erl_script_timeout, Value}, _) ->
+ {error, {wrong_type, {erl_script_timeout, Value}}};
+store({erl_script_nocache, Value} = Conf, _) when Value == true;
+ Value == false ->
+ {ok, Conf};
+store({erl_script_nocache, Value}, _) ->
+ {error, {wrong_type, {erl_script_nocache, Value}}}.
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+generate_response(ModData) ->
+ case scheme(ModData#mod.request_uri, ModData#mod.config_db) of
+ {eval, ESIBody, Modules} ->
+ eval(ModData, ESIBody, Modules);
+ {erl, ESIBody, Modules} ->
+ erl(ModData, ESIBody, Modules);
+ no_scheme ->
+ {proceed, ModData#mod.data}
+ end.
+
+scheme(RequestURI, ConfigDB) ->
+ case match_script(RequestURI, ConfigDB, erl_script_alias) of
+ no_match ->
+ case match_script(RequestURI, ConfigDB, eval_script_alias) of
+ no_match ->
+ no_scheme;
+ {EsiBody, ScriptModules} ->
+ {eval, EsiBody, ScriptModules}
+ end;
+ {EsiBody, ScriptModules} ->
+ {erl, EsiBody, ScriptModules}
+ end.
+
+match_script(RequestURI, ConfigDB, AliasType) ->
+ case httpd_util:multi_lookup(ConfigDB, AliasType) of
+ [] ->
+ no_match;
+ AliasAndMods ->
+ match_esi_script(RequestURI, AliasAndMods, AliasType)
+ end.
+
+match_esi_script(_, [], _) ->
+ no_match;
+match_esi_script(RequestURI, [{Alias,Modules} | Rest], AliasType) ->
+ AliasMatchStr = alias_match_str(Alias, AliasType),
+ case inets_regexp:first_match(RequestURI, AliasMatchStr) of
+ {match, 1, Length} ->
+ {string:substr(RequestURI, Length + 1), Modules};
+ nomatch ->
+ match_esi_script(RequestURI, Rest, AliasType)
+ end.
+
+alias_match_str(Alias, erl_script_alias) ->
+ "^" ++ Alias ++ "/";
+alias_match_str(Alias, eval_script_alias) ->
+ "^" ++ Alias ++ "\\?".
+
+
+%%------------------------ Erl mechanism --------------------------------
+
+erl(#mod{method = Method} = ModData, ESIBody, Modules)
+ when Method == "GET"; Method == "HEAD"->
+ case httpd_util:split(ESIBody,":|%3A|/",2) of
+ {ok, [ModuleName, FuncAndInput]} ->
+ case httpd_util:split(FuncAndInput,"[\?/]",2) of
+ {ok, [FunctionName, Input]} ->
+ generate_webpage(ModData, ESIBody, Modules,
+ list_to_atom(ModuleName),
+ FunctionName, Input,
+ script_elements(FuncAndInput, Input));
+ {ok, [FunctionName]} ->
+ generate_webpage(ModData, ESIBody, Modules,
+ list_to_atom(ModuleName),
+ FunctionName, "",
+ script_elements(FuncAndInput, ""));
+ {ok, BadRequest} ->
+ {proceed,[{status,{400,none, BadRequest}} |
+ ModData#mod.data]}
+ end;
+ {ok, BadRequest} ->
+ {proceed, [{status,{400, none, BadRequest}} | ModData#mod.data]}
+ end;
+
+erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) ->
+ case httpd_util:split(ESIBody,":|%3A|/",2) of
+ {ok,[ModuleName, Function]} ->
+ generate_webpage(ModData, ESIBody, Modules,
+ list_to_atom(ModuleName),
+ Function, Body, [{entity_body, Body}]);
+ {ok, BadRequest} ->
+ {proceed,[{status, {400, none, BadRequest}} | ModData#mod.data]}
+ end.
+
+generate_webpage(ModData, ESIBody, [all], Module, FunctionName,
+ Input, ScriptElements) ->
+ generate_webpage(ModData, ESIBody, [Module], Module,
+ FunctionName, Input, ScriptElements);
+generate_webpage(ModData, ESIBody, Modules, Module, FunctionName,
+ Input, ScriptElements) ->
+ Function = list_to_atom(FunctionName),
+ case lists:member(Module, Modules) of
+ true ->
+ Env = httpd_script_env:create_env(esi, ModData, ScriptElements),
+ case erl_scheme_webpage_chunk(Module, Function,
+ Env, Input, ModData) of
+ {error, erl_scheme_webpage_chunk_undefined} ->
+ erl_scheme_webpage_whole(Module, Function, Env, Input,
+ ModData);
+ ResponseResult ->
+ ResponseResult
+ end;
+ false ->
+ {proceed, [{status, {403, ModData#mod.request_uri,
+ ?NICE("Client not authorized to evaluate: "
+ ++ ESIBody)}} | ModData#mod.data]}
+ end.
+
+%% Old API that waits for the dymnamic webpage to be totally generated
+%% before anythig is sent back to the client.
+erl_scheme_webpage_whole(Module, Function, Env, Input, ModData) ->
+ case (catch Module:Function(Env, Input)) of
+ {'EXIT',{undef, _}} ->
+ {proceed, [{status, {404, ModData#mod.request_uri, "Not found"}}
+ | ModData#mod.data]};
+ {'EXIT',Reason} ->
+ {proceed, [{status, {500, none, Reason}} |
+ ModData#mod.data]};
+ Response ->
+ {Headers, Body} =
+ httpd_esi:parse_headers(lists:flatten(Response)),
+ Length = httpd_util:flatlength(Body),
+ case httpd_esi:handle_headers(Headers) of
+ {proceed, AbsPath} ->
+ {proceed, [{real_name, httpd_util:split_path(AbsPath)}
+ | ModData#mod.data]};
+ {ok, NewHeaders, StatusCode} ->
+ send_headers(ModData, StatusCode,
+ [{"content-length",
+ integer_to_list(Length)}| NewHeaders]),
+ case ModData#mod.method of
+ "HEAD" ->
+ {proceed, [{response, {already_sent, 200, 0}} |
+ ModData#mod.data]};
+ _ ->
+ httpd_response:send_body(ModData,
+ StatusCode, Body),
+ {proceed, [{response, {already_sent, 200,
+ Length}} |
+ ModData#mod.data]}
+ end
+ end
+ end.
+
+%% New API that allows the dynamic wepage to be sent back to the client
+%% in small chunks at the time during generation.
+erl_scheme_webpage_chunk(Mod, Func, Env, Input, ModData) ->
+ process_flag(trap_exit, true),
+ Self = self(),
+ %% Spawn worker that generates the webpage.
+ %% 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
+ Pid = spawn_link(
+ fun() ->
+ case catch Mod:Func(Self, Env, Input) of
+ {'EXIT',{undef,_}} ->
+ %% Will force fallback on the old API
+ exit(erl_scheme_webpage_chunk_undefined);
+ _ ->
+ ok
+ end
+ end),
+
+ Response = deliver_webpage_chunk(ModData, Pid),
+
+ process_flag(trap_exit,false),
+ Response.
+
+deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid) ->
+ Timeout = erl_script_timeout(Db),
+ deliver_webpage_chunk(ModData, Pid, Timeout).
+
+deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) ->
+ case receive_headers(Timeout) of
+ {error, Reason} ->
+ %% Happens when webpage generator callback/3 is undefined
+ {error, Reason};
+ {Headers, Body} ->
+ case httpd_esi:handle_headers(Headers) of
+ {proceed, AbsPath} ->
+ {proceed, [{real_name, httpd_util:split_path(AbsPath)}
+ | ModData#mod.data]};
+ {ok, NewHeaders, StatusCode} ->
+ IsDisableChunkedSend =
+ httpd_response:is_disable_chunked_send(Db),
+ case (ModData#mod.http_version =/= "HTTP/1.1") or
+ (IsDisableChunkedSend) of
+ true ->
+ send_headers(ModData, StatusCode,
+ [{"connection", "close"} |
+ NewHeaders]);
+ false ->
+ send_headers(ModData, StatusCode,
+ [{"transfer-encoding",
+ "chunked"} | NewHeaders])
+ end,
+ handle_body(Pid, ModData, Body, Timeout, length(Body),
+ IsDisableChunkedSend)
+ end;
+ timeout ->
+ send_headers(ModData, {504, "Timeout"},[{"connection", "close"}]),
+ httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket),
+ process_flag(trap_exit,false),
+ {proceed,[{response, {already_sent, 200, 0}} | ModData#mod.data]}
+ end.
+
+receive_headers(Timeout) ->
+ receive
+ {ok, Chunk} ->
+ httpd_esi:parse_headers(lists:flatten(Chunk));
+ {'EXIT', Pid, erl_scheme_webpage_chunk_undefined} when is_pid(Pid) ->
+ {error, erl_scheme_webpage_chunk_undefined};
+ {'EXIT', Pid, Reason} when is_pid(Pid) ->
+ exit({mod_esi_linked_process_died, Pid, Reason})
+ after Timeout ->
+ timeout
+ end.
+
+send_headers(ModData, StatusCode, HTTPHeaders) ->
+ ExtraHeaders = httpd_response:cache_headers(ModData),
+ httpd_response:send_header(ModData, StatusCode,
+ ExtraHeaders ++ HTTPHeaders).
+
+handle_body(_, #mod{method = "HEAD"} = ModData, _, _, Size, _) ->
+ process_flag(trap_exit,false),
+ {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]};
+
+handle_body(Pid, ModData, Body, Timeout, Size, IsDisableChunkedSend) ->
+ httpd_response:send_chunk(ModData, Body, IsDisableChunkedSend),
+ receive
+ {ok, Data} ->
+ handle_body(Pid, ModData, Data, Timeout, Size + length(Data),
+ IsDisableChunkedSend);
+ {'EXIT', Pid, normal} when is_pid(Pid) ->
+ httpd_response:send_final_chunk(ModData, IsDisableChunkedSend),
+ {proceed, [{response, {already_sent, 200, Size}} |
+ ModData#mod.data]};
+ {'EXIT', Pid, Reason} when is_pid(Pid) ->
+ exit({mod_esi_linked_process_died, Pid, Reason})
+ after Timeout ->
+ process_flag(trap_exit,false),
+ {proceed,[{response, {already_sent, 200, Size}} |
+ ModData#mod.data]}
+ end.
+
+erl_script_timeout(Db) ->
+ httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT).
+
+script_elements(FuncAndInput, Input) ->
+ case input_type(FuncAndInput) of
+ path_info ->
+ [{path_info, Input}];
+ query_string ->
+ [{query_string, Input}];
+ _ ->
+ []
+ end.
+
+input_type([]) ->
+ no_input;
+input_type([$/|_Rest]) ->
+ path_info;
+input_type([$?|_Rest]) ->
+ query_string;
+input_type([_First|Rest]) ->
+ input_type(Rest).
+
+%%------------------------ Eval mechanism --------------------------------
+
+eval(#mod{request_uri = ReqUri, method = "POST",
+ http_version = Version, data = Data}, _ESIBody, _Modules) ->
+ {proceed,[{status,{501,{"POST", ReqUri, Version},
+ ?NICE("Eval mechanism doesn't support method POST")}}|
+ Data]};
+
+eval(#mod{method = Method} = ModData, ESIBody, Modules)
+ when Method == "GET"; Method == "HEAD" ->
+ case is_authorized(ESIBody, Modules) of
+ true ->
+ case generate_webpage(ESIBody) of
+ {error, Reason} ->
+ {proceed, [{status, {500, none, Reason}} |
+ ModData#mod.data]};
+ {ok, Response} ->
+ {Headers, _} =
+ httpd_esi:parse_headers(lists:flatten(Response)),
+ case httpd_esi:handle_headers(Headers) of
+ {ok, _, StatusCode} ->
+ {proceed,[{response, {StatusCode, Response}} |
+ ModData#mod.data]};
+ {proceed, AbsPath} ->
+ {proceed, [{real_name, AbsPath} |
+ ModData#mod.data]}
+ end
+ end;
+ false ->
+ {proceed,[{status,
+ {403, ModData#mod.request_uri,
+ ?NICE("Client not authorized to evaluate: "
+ ++ ESIBody)}} | ModData#mod.data]}
+ end.
+
+generate_webpage(ESIBody) ->
+ (catch lib:eval_str(string:concat(ESIBody,". "))).
+
+is_authorized(_ESIBody, [all]) ->
+ true;
+is_authorized(ESIBody, Modules) ->
+ case inets_regexp:match(ESIBody, "^[^\:(%3A)]*") of
+ {match, Start, Length} ->
+ lists:member(list_to_atom(string:substr(ESIBody, Start, Length)),
+ Modules);
+ nomatch ->
+ false
+ end.
diff --git a/lib/inets/src/http_server/mod_get.erl b/lib/inets/src/http_server/mod_get.erl
new file mode 100644
index 0000000000..9fd1fcec47
--- /dev/null
+++ b/lib/inets/src/http_server/mod_get.erl
@@ -0,0 +1,126 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_get).
+-export([do/1]).
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ case Info#mod.method of
+ "GET" ->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) 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),
+
+ send_response(Info#mod.socket,Info#mod.socket_type, Path, Info).
+
+
+%% The common case when no range is specified
+send_response(_Socket, _SocketType, Path, Info)->
+ %% Send the file!
+ %% Find the modification date of the file
+ case file:open(Path,[raw,binary]) of
+ {ok, FileDescriptor} ->
+ {FileInfo, LastModified} = get_modification_date(Path),
+ ?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),
+ Size = integer_to_list(FileInfo#file_info.size),
+ Headers = case Info#mod.http_version of
+ "HTTP/1.1" ->
+ [{content_type, MimeType},
+ {etag, httpd_util:create_etag(FileInfo)},
+ {content_length, Size}|LastModified];
+ %% OTP-4935
+ _ ->
+ %% i.e http/1.0 and http/0.9
+ [{content_type, MimeType},
+ {content_length, Size}|LastModified]
+ end,
+ send(Info, 200, Headers, FileDescriptor),
+ file:close(FileDescriptor),
+ {proceed,[{response,{already_sent,200,
+ FileInfo#file_info.size}},
+ {mime_type,MimeType}|Info#mod.data]};
+ {error, Reason} ->
+ Status = httpd_file:handle_error(Reason, "open", Info, Path),
+ {proceed,
+ [{status, Status}| Info#mod.data]}
+ end.
+
+%% send
+
+send(#mod{socket = Socket, socket_type = SocketType} = Info,
+ StatusCode, Headers, FileDescriptor) ->
+ ?DEBUG("send -> send header",[]),
+ httpd_response:send_header(Info, StatusCode, Headers),
+ send_body(SocketType,Socket,FileDescriptor).
+
+
+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.
+
+get_modification_date(Path)->
+ {ok, FileInfo0} = file:read_file_info(Path),
+ LastModified =
+ case catch httpd_util:rfc1123_date(FileInfo0#file_info.mtime) of
+ Date when is_list(Date) -> [{last_modified, Date}];
+ _ -> []
+ end,
+ {FileInfo0, LastModified}.
diff --git a/lib/inets/src/http_server/mod_head.erl b/lib/inets/src/http_server/mod_head.erl
new file mode 100644
index 0000000000..8b08d61651
--- /dev/null
+++ b/lib/inets/src/http_server/mod_head.erl
@@ -0,0 +1,75 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_head).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"HEAD").
+
+%% do
+
+do(Info) ->
+ case Info#mod.method of
+ "HEAD" ->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ _undefined ->
+ case proplists:get_value(response, Info#mod.data) 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) ->
+ 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} ->
+ Status = httpd_file:handle_error(Reason, "access", Info, Path),
+ {proceed,
+ [{status, Status} | Info#mod.data]}
+ end.
diff --git a/lib/inets/src/http_server/mod_htaccess.erl b/lib/inets/src/http_server/mod_htaccess.erl
new file mode 100644
index 0000000000..d8835198f5
--- /dev/null
+++ b/lib/inets/src/http_server/mod_htaccess.erl
@@ -0,0 +1,1078 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(mod_htaccess).
+
+-export([do/1, load/2, store/2]).
+
+-include("httpd.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Public methods that interface the eswapi %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+% Public method called by the webbserver to insert the data about
+% Names on accessfiles
+%----------------------------------------------------------------------
+load("AccessFileName" ++ FileNames, _Context)->
+ CleanFileNames=httpd_conf:clean(FileNames),
+ {ok,[],{access_files,string:tokens(CleanFileNames," ")}}.
+
+store({access_files, Files} = Conf, _) when is_list(Files)->
+ {ok, Conf};
+store({access_files, Value}, _) ->
+ {error, {wrong_type, {access_files, Value}}}.
+
+%----------------------------------------------------------------------
+% Public method that the webbserver calls to control the page
+%----------------------------------------------------------------------
+do(Info)->
+ case proplists:get_value(status, Info#mod.data) of
+ {_Status_code, _PhraseArgs, _Reason}->
+ {proceed,Info#mod.data};
+ undefined ->
+ control_path(Info)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The functions that start the control if there is a accessfile %%
+%% and if so controls if the dir is allowed or not %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%Info = record mod as specified in httpd.hrl
+%returns either {proceed,Info#mod.data}
+%{proceed,[{status,403....}|Info#mod.data]}
+%{proceed,[{status,401....}|Info#mod.data]}
+%{proceed,[{status,500....}|Info#mod.data]}
+%----------------------------------------------------------------------
+control_path(Info) ->
+ Path = mod_alias:path(Info#mod.data,
+ Info#mod.config_db,
+ Info#mod.request_uri),
+ case isErlScriptOrNotAccessibleFile(Path,Info) of
+ true->
+ {proceed,Info#mod.data};
+ false->
+ case getHtAccessData(Path,Info)of
+ {ok,public}->
+ %%There was no restrictions on the page continue
+ {proceed,Info#mod.data};
+ {error, _Reason} ->
+ %%Something got wrong continue or quit??????????????????/
+ {proceed,Info#mod.data};
+ {accessData,AccessData}->
+ controlAllowedMethod(Info,AccessData)
+ end
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% These methods controls that the method the client used in the %%
+%% request is one of the limited %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%Control that if the accessmethod used is in the list of modes to challenge
+%
+%Info is the mod record as specified in httpd.hrl
+%AccessData is an ets table whit the data in the .htaccessfiles
+%----------------------------------------------------------------------
+controlAllowedMethod(Info,AccessData)->
+ case allowedRequestMethod(Info,AccessData) of
+ allow->
+ %%The request didnt use one of the limited methods
+ ets:delete(AccessData),
+ {proceed,Info#mod.data};
+ challenge->
+ authenticateUser(Info,AccessData)
+ end.
+
+%----------------------------------------------------------------------
+%Check the specified access method in the .htaccessfile
+%----------------------------------------------------------------------
+allowedRequestMethod(Info,AccessData)->
+ case ets:lookup(AccessData,limit) of
+ [{limit,all}]->
+ challenge;
+ [{limit,Methods}]->
+ isLimitedRequestMethod(Info,Methods)
+ end.
+
+
+%----------------------------------------------------------------------
+%Check the specified accessmethods in the .htaccesfile against the users
+%accessmethod
+%
+%Info is the record from the do call
+%Methods is a list of the methods specified in the .htaccessfile
+%----------------------------------------------------------------------
+isLimitedRequestMethod(Info,Methods)->
+ case lists:member(Info#mod.method,Methods) of
+ true->
+ challenge;
+ false ->
+ allow
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% These methods controls that the user comes from an allowwed net %%
+%% and if so wheather its a valid user or a challenge shall be %%
+%% generated %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%The first thing to control is that the user is from a network
+%that has access to the page
+%----------------------------------------------------------------------
+authenticateUser(Info,AccessData)->
+ case controlNet(Info,AccessData) of
+ allow->
+ %the network is ok control that it is an allowed user
+ authenticateUser2(Info,AccessData);
+ deny->
+ %The user isnt allowed to access the pages from that network
+ ets:delete(AccessData),
+ {proceed,[{status,{403,Info#mod.request_uri,
+ "Restricted area not allowed from your network"}}|Info#mod.data]}
+ end.
+
+
+%----------------------------------------------------------------------
+%The network the user comes from is allowed to view the resources
+%control whether the user needsto supply a password or not
+%----------------------------------------------------------------------
+authenticateUser2(Info,AccessData)->
+ case ets:lookup(AccessData,require) of
+ [{require,AllowedUsers}]->
+ case ets:lookup(AccessData,auth_name) of
+ [{auth_name,Realm}]->
+ authenticateUser2(Info,AccessData,Realm,AllowedUsers);
+ _NoAuthName->
+ ets:delete(AccessData),
+ {break,[{status,{500,none,
+ ?NICE("mod_htaccess:AuthName directive "
+ "not specified")}}]}
+ end;
+ [] ->
+ %%No special user is required the network is ok so let
+ %%the user in
+ ets:delete(AccessData),
+ {proceed,Info#mod.data}
+ end.
+
+
+%----------------------------------------------------------------------
+%The user must send a userId and a password to get the resource
+%Control if its already in the http-request
+%if the file with users is bad send an 500 response
+%----------------------------------------------------------------------
+authenticateUser2(Info,AccessData,Realm,AllowedUsers)->
+ case authenticateUser(Info,AccessData,AllowedUsers) of
+ allow ->
+ ets:delete(AccessData),
+ {user,Name, _Pwd} = getAuthenticatingDataFromHeader(Info),
+ {proceed, [{remote_user_name,Name}|Info#mod.data]};
+ challenge->
+ ets:delete(AccessData),
+ ReasonPhrase = httpd_util:reason_phrase(401),
+ Message = httpd_util:message(401,none,Info#mod.config_db),
+ {proceed,
+ [{response,
+ {401,
+ ["WWW-Authenticate: Basic realm=\"",Realm,
+ "\"\r\n\r\n","<HTML>\n<HEAD>\n<TITLE>",
+ ReasonPhrase,"</TITLE>\n",
+ "</HEAD>\n<BODY>\n<H1>",ReasonPhrase,
+ "</H1>\n",Message,"\n</BODY>\n</HTML>\n"]}}|
+ Info#mod.data]};
+ deny->
+ ets:delete(AccessData),
+ {break,[{status,{500,none,
+ ?NICE("mod_htaccess:Bad path to user "
+ "or group file")}}]}
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Methods that validate the netwqork the user comes from %%
+%% according to the allowed networks %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%---------------------------------------------------------------------
+%Controls the users networkaddress agains the specifed networks to
+%allow or deny
+%
+%returns either allow or deny
+%----------------------------------------------------------------------
+controlNet(Info,AccessData)->
+ UserNetwork=getUserNetworkAddress(Info),
+ case getAllowDenyOrder(AccessData) of
+ {_deny,[],_allow,[]}->
+ allow;
+ {deny,[],allow,AllowedNetworks}->
+ controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny);
+ {allow,AllowedNetworks,deny,[]}->
+ controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny);
+
+ {deny,DeniedNetworks,allow,[]}->
+ controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny);
+ {allow,[],deny,DeniedNetworks}->
+ controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny);
+
+ {deny,DeniedNetworks,allow,AllowedNetworks}->
+ controlDenyAllow(DeniedNetworks,AllowedNetworks,UserNetwork);
+ {allow,AllowedNetworks,deny,DeniedNetworks}->
+ controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork)
+ end.
+
+
+%----------------------------------------------------------------------
+%Returns the users IP-Number
+%----------------------------------------------------------------------
+getUserNetworkAddress(Info)->
+ {_Socket,Address}=(Info#mod.init_data)#init_data.peername,
+ Address.
+
+
+%----------------------------------------------------------------------
+%Control the users Ip-number against the ip-numbers in the .htaccessfile
+%----------------------------------------------------------------------
+controlIfAllowed(AllowedNetworks,UserNetwork,IfAllowed,IfDenied)->
+ case AllowedNetworks of
+ [{allow,all}]->
+ IfAllowed;
+ [{deny,all}]->
+ IfDenied;
+ [{deny,Networks}]->
+ memberNetwork(Networks,UserNetwork,IfDenied,IfAllowed);
+ [{allow,Networks}]->
+ memberNetwork(Networks,UserNetwork,IfAllowed,IfDenied);
+ _Error->
+ IfDenied
+ end.
+
+
+%---------------------------------------------------------------------%
+%The Denycontrol isn't neccessary to preform since the allow control %
+%override the deny control %
+%---------------------------------------------------------------------%
+controlDenyAllow(_DeniedNetworks, AllowedNetworks, UserNetwork)->
+ case AllowedNetworks of
+ [{allow, all}]->
+ allow;
+ [{allow, Networks}]->
+ case memberNetwork(Networks, UserNetwork) of
+ true->
+ allow;
+ false->
+ deny
+ end
+ end.
+
+
+%----------------------------------------------------------------------%
+%Control that the user is in the allowed list if so control that the %
+%network is in the denied list
+%----------------------------------------------------------------------%
+controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork)->
+ case controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny) of
+ allow->
+ controlIfAllowed(DeniedNetworks,UserNetwork,deny,allow);
+ deny ->
+ deny
+ end.
+
+%----------------------------------------------------------------------
+%Controls if the users Ipnumber is in the list of either denied or
+%allowed networks
+%----------------------------------------------------------------------
+memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)->
+ case memberNetwork(Networks,UserNetwork) of
+ true->
+ IfTrue;
+ false->
+ IfFalse
+ end.
+
+
+%----------------------------------------------------------------------
+%regexp match the users ip-address against the networks in the list of
+%ipadresses or subnet addresses.
+memberNetwork(Networks,UserNetwork)->
+ case lists:filter(fun(Net)->
+ case inets_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 proplists:get_value("authorization", PrsedHeader) of
+ undefined->
+ {error,nouser};
+ [$B,$a,$s,$i,$c,$\ |EncodedString] = Credentials ->
+ case (catch base64:decode_to_string(EncodedString)) of
+ {'EXIT',{function_clause, _}} ->
+ {error, Credentials};
+ UnCodedString ->
+ case httpd_util:split(UnCodedString,":",2) of
+ {ok,[User,PassWord]}->
+ {user,User,PassWord};
+ {error,Error}->
+ {error,Error}
+ end
+ 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}->
+ {ok, Members } = getGroupMembers(Groups,AllowedGroups),
+ authenticateUser(Info,AccessData,{users,Members},
+ {user,User,PassWord});
+ {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 inets_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;
+ _ ->
+ 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 is_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("order"++ 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("allow" ++ 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("deny" ++ 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("require" ++ 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("</Limit" ++ _EndLimit, {Context,FileData})->
+ [Context | FileData];
+insertLine("<Limit" ++ 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("AllowOverRide" ++ 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("AuthType" ++ 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
+ ["all" ++ _] ->
+ all;
+ ["none" ++ _]->
+ none;
+ Directives ->
+ getOverRideDirectives(Directives)
+ end.
+
+getOverRideDirectives(Directives)->
+ lists:map(fun(Directive)->
+ transformDirective(Directive)
+ end,Directives).
+transformDirective("AuthUserFile" ++ _)->
+ user_file;
+transformDirective("AuthGroupFile" ++ _) ->
+ group_file;
+transformDirective("AuthName" ++ _)->
+ auth_name;
+transformDirective("AuthType" ++ _)->
+ 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
+ "Basic"->
+ basic;
+ "MD5" ->
+ md5;
+ _What ->
+ error
+ end.
+%----------------------------------------------------------------------
+%Returns a list of the specified methods to limit or the atom all
+%----------------------------------------------------------------------
+getLimits(Limits)->
+ case inets_regexp:split(Limits,">")of
+ {ok,[_NoEndOnLimit]}->
+ error;
+ {ok, [Methods | _Crap]}->
+ case inets_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
+ "all" ->
+ all;
+ _Hosts->
+ AllowDenyData
+ end;
+ _ ->
+ error
+ 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
+ "user"->
+ {users,UserData};
+ "group" ->
+ {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, _}->
+ [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.
diff --git a/lib/inets/src/http_server/mod_include.erl b/lib/inets/src/http_server/mod_include.erl
new file mode 100644
index 0000000000..534eba8a36
--- /dev/null
+++ b/lib/inets/src/http_server/mod_include.erl
@@ -0,0 +1,597 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-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").
+
+%% do
+
+do(Info) ->
+ case Info#mod.method of
+ "GET" ->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) 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) ->
+ 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 = [{content_type, "text/html"}],
+ case send_in(Info, Path, HeaderStart, file:read_file_info(Path)) of
+ {ok, ErrorLog, Size} ->
+ {proceed, [{response, {already_sent, 200, Size}},
+ {mime_type, "text/html"} |
+ lists:append(ErrorLog, Info#mod.data)]};
+ {error, Reason} ->
+ {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],
+ proplists:get_value(errmsg,Context,""),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], proplists:get_value(errmsg, Context, ""), R}.
+
+include(Info, Context, ErrorLog, R, Path) ->
+ case file:read_file(Path) of
+ {ok, Body} ->
+ {ok, NewContext, NewErrorLog, Result} =
+ parse(Info, binary_to_list(Body), Context, ErrorLog, []),
+ {ok, NewContext, NewErrorLog, Result, R};
+ {error, _Reason} ->
+ {ok, Context,
+ [{internal_info, ?NICE("Can't open "++Path)}|ErrorLog],
+ proplists:get_value(errmsg, Context, ""), 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 inets_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} = mod_alias:real_name(ConfigDB, RequestURI, Aliases),
+
+ VirtualPath = string:substr(RequestURI, 1,
+ length(RequestURI)-length(AfterPath)),
+ {match, Start, Length} = inets_regexp:match(Path,"[^/]*\$"),
+ FileName = string:substr(Path,Start,Length),
+ case inets_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 inets_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],proplists:get_value(errmsg,Context,""),R}.
+
+fsize(_Info, Context, ErrorLog, R, Path) ->
+ case file:read_file_info(Path) of
+ {ok,FileInfo} ->
+ case proplists:get_value(sizefmt,Context) 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],
+ proplists:get_value(errmsg, Context, ""), R}
+ end;
+ {error, _Reason} ->
+ {ok,Context,[{internal_info,?NICE("Can't open "++Path)}|ErrorLog],
+ proplists:get_value(errmsg,Context,""),R}
+ end.
+
+%%
+%% flastmod directive
+%%
+
+flastmod(#mod{config_db = Db} = Info,
+ Context, ErrorLog, [virtual], [VirtualPath],R) ->
+ Aliases = httpd_util:multi_lookup(Db,alias),
+ {_,Path, _AfterPath} = mod_alias:real_name(Db, VirtualPath, Aliases),
+ flastmod(Info,Context,ErrorLog,R,Path);
+flastmod(#mod{config_db = Db, request_uri = RequestUri} = Info,
+ Context, ErrorLog, [file], [FileName], R) ->
+ Path = file(Db, RequestUri, 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],proplists:get_value(errmsg,Context,""),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],
+ proplists:get_value(errmsg,Context,""),R}
+ end.
+
+%%
+%% exec directive
+%%
+
+exec(Info,Context,ErrorLog,[cmd],[Command],R) ->
+ cmd(Info,Context,ErrorLog,R,Command);
+exec(Info,Context,ErrorLog,[cgi],[RequestURI],R) ->
+ cgi(Info,Context,ErrorLog,R,RequestURI);
+exec(_Info, Context, ErrorLog, _TagList, _ValueList, R) ->
+ {ok, Context,
+ [{internal_info,?NICE("exec directive has a spurious tag")}|
+ ErrorLog], proplists:get_value(errmsg,Context,""),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 is_port(P) ->
+ {NewErrorLog, Result} = proxy(Port, ErrorLog),
+ {ok, Context, NewErrorLog, Result, R};
+ {'EXIT', Reason} ->
+ exit({open_port_failed,Reason,
+ [{uri,Info#mod.request_uri},{script,Command},
+ {env,Env},{dir,Dir}]});
+ 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], proplists:get_value(errmsg, Context, ""),R}
+ end.
+
+remove_header([]) ->
+ [];
+remove_header([$\n,$\n|Rest]) ->
+ Rest;
+remove_header([_C|Rest]) ->
+ remove_header(Rest).
+
+
+exec_script(#mod{config_db = Db, request_uri = RequestUri} = Info,
+ Script, _AfterScript, ErrorLog, Context, R) ->
+ process_flag(trap_exit,true),
+ Aliases = httpd_util:multi_lookup(Db, alias),
+ {_, Path, AfterPath} = mod_alias:real_name(Db, RequestUri, 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 is_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} ->
+ exit({open_cmd_failed,Reason,
+ [{mod,?MODULE},{port,Port},
+ {uri,RequestUri},
+ {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} ->
+ exit({open_port_failed,Reason,
+ [{mod,?MODULE},{uri,RequestUri},{script,Script},
+ {env,Env},{dir,Dir}]});
+ O ->
+ exit({open_port_failed,O,
+ [{mod,?MODULE},{uri,RequestUri},{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 is_port(Port) ->
+ process_flag(trap_exit, false),
+ {ErrorLog, Result};
+ {'EXIT', Port, _Reason} when is_port(Port) ->
+ process_flag(trap_exit, false),
+ {[{internal_info,
+ ?NICE("Scrambled output from CGI-script")}|ErrorLog],
+ Result};
+ {'EXIT', Pid, Reason} when is_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} ->
+ {error, {read,Reason}}
+ end;
+send_in(_Info , _Path, _Head,{error,Reason}) ->
+ {error, {open,Reason}}.
+
+send_in1(Info, Data, Head, FileInfo) ->
+ {ok, _Context, Err, ParsedBody} = parse(Info,Data,?DEFAULT_CONTEXT,[],[]),
+ Size = length(ParsedBody),
+ LastModified = case catch httpd_util:rfc1123_date(FileInfo#file_info.mtime) of
+ Date when is_list(Date) -> [{last_modified,Date}];
+ _ -> []
+ end,
+ Head1 = case Info#mod.http_version of
+ "HTTP/1.1"->
+ Head ++ [{content_length, integer_to_list(Size)},
+ {etag, httpd_util:create_etag(FileInfo,Size)}|
+ LastModified];
+ _->
+ %% i.e http/1.0 and http/0.9
+ Head ++ [{content_length, integer_to_list(Size)}|
+ LastModified]
+ end,
+ httpd_response:send_header(Info, 200, Head1),
+ httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket, ParsedBody),
+ {ok, Err, Size}.
+
+
+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) ->
+ 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} ->
+ {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) ->
+ case catch parse5(R1,[],0) of
+ {parse_error,Reason} ->
+ parse(Info,R1,Context,
+ [{internal_info,?NICE(Reason)}|ErrorLog],Result);
+ {Comment,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) ->
+ 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 is_binary(B) -> {binary,size(B)};
+sz(L) when is_list(L) -> {list,length(L)};
+sz(_) -> undefined.
+
+%% send_error - Handle failure to send the file
+%%
+send_error({open,Reason},Info,Path) ->
+ httpd_file:handle_error(Reason, "open", Info, Path);
+send_error({read,Reason},Info,Path) ->
+ httpd_file:handle_error(Reason, "read", Info, Path).
+
+
+
+
diff --git a/lib/inets/src/http_server/mod_log.erl b/lib/inets/src/http_server/mod_log.erl
new file mode 100644
index 0000000000..de24d5a569
--- /dev/null
+++ b/lib/inets/src/http_server/mod_log.erl
@@ -0,0 +1,256 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_log).
+
+%% Application internal API
+-export([error_log/2, security_log/2, report_error/2]).
+
+%% Callback API
+-export([do/1, load/2, store/2, remove/1]).
+
+-include("httpd.hrl").
+-define(VMODULE,"LOG").
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+%% security log
+security_log(Info, ReasonStr) ->
+ Date = httpd_util:custom_date(),
+ case httpd_log:security_entry(security_log, no_security_log, Info,
+ Date, ReasonStr) of
+ no_security_log ->
+ ok;
+ {Log, Entry} ->
+ io:format(Log, "~s", [Entry])
+ end.
+
+%% error_log
+error_log(Info, Reason) ->
+ Date = httpd_util:custom_date(),
+ error_log(Info, Date, Reason).
+
+error_log(Info, Date, Reason) ->
+ case httpd_log:error_entry(error_log, no_error_log,
+ Info, Date, Reason) of
+ no_error_log ->
+ ok;
+ {Log, Entry} ->
+ io:format(Log, "~s", [Entry])
+ end.
+
+report_error(ConfigDB, Error) ->
+ Date = httpd_util:custom_date(),
+ case httpd_log:error_report_entry(error_log, no_error_log, ConfigDB,
+ Date, Error) of
+ no_error_log ->
+ ok;
+ {Log, Entry} ->
+ io:format(Log, "~s", [Entry])
+ end.
+
+%%%=========================================================================
+%%% CALLBACK API
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% do(ModData) -> {proceed, OldData} | {proceed, NewData} | {break, NewData}
+%% | done
+%% ModData = #mod{}
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+do(Info) ->
+ AuthUser = auth_user(Info#mod.data),
+ Date = httpd_util:custom_date(),
+ log_internal_info(Info,Date,Info#mod.data),
+ case proplists:get_value(status, Info#mod.data) 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 proplists:get_value(response, Info#mod.data) of
+ {already_sent,StatusCode,Size} ->
+ transfer_log(Info,"-",AuthUser,Date,StatusCode,Size),
+ {proceed,Info#mod.data};
+ {response, Head, _Body} ->
+ Size = proplists:get_value(content_length,Head,unknown),
+ Code = proplists:get_value(code,Head,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.
+
+%%--------------------------------------------------------------------------
+%% load(Line, Context) -> eof | ok | {ok, NewContext} |
+%% {ok, NewContext, Directive} |
+%% {ok, NewContext, DirectiveList} | {error, Reason}
+%% Line = string()
+%% Context = NewContext = DirectiveList = [Directive]
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+load("TransferLog " ++ TransferLog, []) ->
+ {ok,[],{transfer_log,httpd_conf:clean(TransferLog)}};
+load("ErrorLog " ++ ErrorLog, []) ->
+ {ok,[],{error_log,httpd_conf:clean(ErrorLog)}};
+load("SecurityLog " ++ SecurityLog, []) ->
+ {ok, [], {security_log, httpd_conf:clean(SecurityLog)}}.
+
+%%--------------------------------------------------------------------------
+%% store(Directive, DirectiveList) -> {ok, NewDirective} |
+%% {ok, [NewDirective]} |
+%% {error, Reason}
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term()
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+store({transfer_log,TransferLog}, ConfigList) when is_list(TransferLog)->
+ case create_log(TransferLog,ConfigList) of
+ {ok,TransferLogStream} ->
+ {ok,{transfer_log,TransferLogStream}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({transfer_log,TransferLog}, _) ->
+ {error, {wrong_type, {transfer_log, TransferLog}}};
+store({error_log,ErrorLog}, ConfigList) when is_list(ErrorLog) ->
+ case create_log(ErrorLog,ConfigList) of
+ {ok,ErrorLogStream} ->
+ {ok,{error_log,ErrorLogStream}};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+store({error_log,ErrorLog}, _) ->
+ {error, {wrong_type, {error_log, ErrorLog}}};
+store({security_log, SecurityLog}, ConfigList) when is_list(SecurityLog) ->
+ case create_log(SecurityLog, ConfigList) of
+ {ok, SecurityLogStream} ->
+ {ok, {security_log, SecurityLogStream}};
+ {error, Reason} ->
+ {error, Reason}
+ end;
+store({security_log, SecurityLog}, _) ->
+ {error, {wrong_type, {security_log, SecurityLog}}}.
+
+%%--------------------------------------------------------------------------
+%% remove(ConfigDb) -> _
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+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.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+%% transfer_log
+transfer_log(Info,RFC931,AuthUser,Date,StatusCode,Bytes) ->
+ case httpd_log:access_entry(transfer_log, no_transfer_log,
+ Info, RFC931, AuthUser, Date,
+ StatusCode, Bytes) of
+ no_transfer_log ->
+ ok;
+ {Log, Entry} ->
+ io:format(Log, "~s", [Entry])
+ 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 proplists:get_value(server_root,ConfigList) 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.
+
+%% 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).
+
+auth_user(Data) ->
+ case proplists:get_value(remote_user, Data) of
+ undefined ->
+ "-";
+ RemoteUser ->
+ RemoteUser
+ end.
+
+
diff --git a/lib/inets/src/http_server/mod_range.erl b/lib/inets/src/http_server/mod_range.erl
new file mode 100644
index 0000000000..0698fb9099
--- /dev/null
+++ b/lib/inets/src/http_server/mod_range.erl
@@ -0,0 +1,419 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_range).
+-export([do/1]).
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+ ?DEBUG("do -> entry",[]),
+ case Info#mod.method of
+ "GET" ->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed,Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) of
+ %% No response has been generated!
+ undefined ->
+ case proplists:get_value("range",
+ Info#mod.parsed_header) 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 proplists:get_value(if_range,
+ Info#mod.data) 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"),
+ {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)} |
+ LastModified],
+ ?DEBUG("send_multi_range_response -> Valid Ranges: ~p",
+ [RagneList]),
+ Body = {fun send_multiranges/4,
+ [ValidRanges, Info, PartMimeType, Path]},
+ {proceed,[{response,
+ {response, Header, Body}} | Info#mod.data]};
+ _ ->
+ {proceed, [{status, {416, "Range not valid",
+ bad_range_boundaries }}]}
+ end;
+ {error, _Reason} ->
+ ?ERROR("do_get -> failed open file: ~p",[_Reason]),
+ {proceed,Info#mod.data}
+ end.
+
+send_multiranges(ValidRanges,Info,PartMimeType,Path)->
+ ?DEBUG("send_multiranges -> Start sending the ranges",[]),
+ case file:open(Path, [raw,binary]) of
+ {ok,FileDescriptor} ->
+ lists:foreach(fun(Range)->
+ send_multipart_start(Range,
+ Info,
+ PartMimeType,
+ FileDescriptor)
+ end,ValidRanges),
+ file:close(FileDescriptor),
+ %%Sends an end of the multipart
+ httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,
+ "\r\n--RangeBoundarySeparator--"),
+ sent;
+ _ ->
+ close
+ end.
+
+send_multipart_start({{Start,End},{StartByte,EndByte,Size}},Info,
+ PartMimeType,FileDescriptor)
+ when StartByte < Size ->
+ PartHeader=["\r\n--RangeBoundarySeparator\r\n","Content-type: ",
+ PartMimeType,"\r\n",
+ "Content-Range:bytes=",integer_to_list(StartByte),"-",
+ integer_to_list(EndByte),"/",
+ integer_to_list(Size),"\r\n\r\n"],
+ send_part_start(Info#mod.socket_type, Info#mod.socket, PartHeader,
+ FileDescriptor, Start, End);
+
+
+send_multipart_start({{Start,End},{StartByte,EndByte,Size}}, Info,
+ PartMimeType, FileDescriptor)->
+ PartHeader=["\r\n--RangeBoundarySeparator\r\n","Content-type: ",
+ PartMimeType,"\r\n",
+ "Content-Range:bytes=",integer_to_list(Size-(StartByte-Size)),
+ "-",integer_to_list(EndByte),"/",
+ integer_to_list(Size),"\r\n\r\n"],
+ send_part_start(Info#mod.socket_type, Info#mod.socket, PartHeader,
+ FileDescriptor, Start, End).
+
+send_part_start(SocketType, Socket, PartHeader, FileDescriptor, Start, End)->
+ case httpd_socket:deliver(SocketType, Socket, PartHeader) of
+ ok ->
+ send_part_start(SocketType,Socket,FileDescriptor,Start,End);
+ _ ->
+ close
+ end.
+
+send_range_response(Path, Info, Start, Stop, FileInfo, LastModified)->
+ case file:open(Path, [raw,binary]) of
+ {ok, FileDescriptor} ->
+ file:close(FileDescriptor),
+ ?DEBUG("send_range_response -> FileDescriptor: ~p",
+ [FileDescriptor]),
+ Suffix = httpd_util:suffix(Path),
+ MimeType = httpd_util:lookup_mime_default(Info#mod.config_db,
+ Suffix,"text/plain"),
+ Size = get_range_size(Start,Stop,FileInfo),
+ case valid_range(Start,Stop,FileInfo) of
+ {true,StartByte,EndByte,TotByte}->
+ Head =[{code,206},{content_type, MimeType},
+ {etag, httpd_util:create_etag(FileInfo)},
+ {content_range,["bytes=",
+ integer_to_list(StartByte),"-",
+ integer_to_list(EndByte),"/",
+ integer_to_list(TotByte)]},
+ {content_length, Size} | LastModified],
+ 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 is_integer(Byte) ->
+ file:position(FileDescriptor,{bof,Start}),
+ send_part(SocketType,Socket,FileDescriptor,End)
+ end,
+ sent.
+
+
+%%This function could replace send_body by calling it with Start=0 end
+%%=FileSize But i gues it would be stupid when we look at performance
+send_part(SocketType,Socket,FileDescriptor,End)->
+ case file:position(FileDescriptor,{cur,0}) of
+ {ok,NewPos} ->
+ if
+ NewPos > End ->
+ ok;
+ true ->
+ Size = get_file_chunk_size(NewPos,End,?FILE_CHUNK_SIZE),
+ case file:read(FileDescriptor,Size) of
+ eof ->
+ ok;
+ {error, _Reason} ->
+ ok;
+ {ok,Binary} ->
+ case httpd_socket:deliver(SocketType,Socket,
+ Binary) of
+ socket_closed ->
+ ?LOG("send_range of body -> socket "
+ "closed while sending",[]),
+ socket_close;
+ _ ->
+ send_part(SocketType,Socket,
+ FileDescriptor,End)
+ end
+ end
+ end;
+ _->
+ ok
+ end.
+
+%% validate that the range is in the limits of the file
+valid_ranges(RangeList, _Path, FileInfo)->
+ lists:mapfoldl(fun({Start,End},Acc)->
+ case Acc of
+ true ->
+ case valid_range(Start,End,FileInfo) of
+ {true,StartB,EndB,Size}->
+ {{{Start,End},
+ {StartB,EndB,Size}},true};
+ _ ->
+ false
+ end;
+ _ ->
+ {false,false}
+ end
+ end,true,RangeList).
+
+
+
+valid_range(from_end,End,FileInfo)->
+ Size=FileInfo#file_info.size,
+ if
+ End < Size ->
+ {true,(Size+End),Size-1,Size};
+ true ->
+ false
+ end;
+valid_range(from_start,End,FileInfo)->
+ Size=FileInfo#file_info.size,
+ if
+ End < Size ->
+ {true,End,Size-1,Size};
+ true ->
+ false
+ end;
+
+valid_range(Start,End,FileInfo) when Start =< End ->
+ case FileInfo#file_info.size of
+ FileSize when Start< FileSize ->
+ case FileInfo#file_info.size of
+ Size when End<Size ->
+ {true,Start,End,FileInfo#file_info.size};
+ Size ->
+ {true,Start,Size-1,Size}
+ end;
+ _->
+ {false,"The size of the range is negative"}
+ end;
+
+valid_range(_Start,_End,_FileInfo)->
+ {false,"Range starts out of file boundaries"}.
+%% Find the modification date of the file
+get_modification_date(Path)->
+ case file:read_file_info(Path) of
+ {ok, FileInfo0} ->
+ case (catch httpd_util:rfc1123_date(FileInfo0#file_info.mtime)) of
+ Date when is_list(Date) ->
+ {FileInfo0, [{last_modified, Date}]};
+ _ ->
+ {FileInfo0, []}
+ end;
+ _ ->
+ {#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("\bytes\=" ++ Ranges)->
+ parse_ranges("bytes\=" ++ Ranges);
+parse_ranges("bytes\=" ++ 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/inets/src/http_server/mod_responsecontrol.erl b/lib/inets/src/http_server/mod_responsecontrol.erl
new file mode 100644
index 0000000000..79e2e1bdba
--- /dev/null
+++ b/lib/inets/src/http_server/mod_responsecontrol.erl
@@ -0,0 +1,303 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(mod_responsecontrol).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+do(Info) ->
+ ?DEBUG("do -> response_control",[]),
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode, _PhraseArgs, _Reason} ->
+ {proceed, Info#mod.data};
+ %% No status code has been generated!
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) 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 proplists:get_value("range", Info#mod.parsed_header) of
+ undefined->
+ undefined;
+ _Range ->
+ case proplists:get_value("if-range", Info#mod.parsed_header) 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(proplists:get_value(HeaderField,
+ Info#mod.parsed_header)) 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(proplists:get_value(HeaderField,
+ Info#mod.parsed_header)) of
+ undefined->
+ undefined;
+ LastModified0 ->
+ LastModified = calendar:universal_time_to_local_time(
+ httpd_util:convert_request_date(LastModified0)),
+ ?DEBUG("control_modification_data() -> "
+ "~n Request-Field: ~s"
+ "~n FileLastModified: ~p"
+ "~n FieldValue: ~p",
+ [HeaderField, ModificationTime, LastModified]),
+ FileTime =
+ calendar:datetime_to_gregorian_seconds(ModificationTime),
+ FieldTime = calendar:datetime_to_gregorian_seconds(LastModified),
+ if
+ FileTime =< FieldTime ->
+ ?DEBUG("File unmodified~n", []), unmodified;
+ FileTime >= FieldTime ->
+ ?DEBUG("File modified~n", []), modified
+ end
+ end.
+
+%% 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([$;,$ | _]) ->
+ [];
+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"),
+ LastModified =
+ case (catch httpd_util:rfc1123_date(FileInfo#file_info.mtime)) of
+ Date when is_list(Date) ->
+ [{last_modified, Date}];
+ _ -> %% This will rarly happen, but could happen
+ %% if a computer is wrongly configured.
+ []
+ end,
+
+ Header = [{code,304},
+ {etag, httpd_util:create_etag(FileInfo)},
+ {content_length,"0"}, {mime_type, MimeType} | LastModified],
+ {response, {response, Header, nobody}}.
diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl
new file mode 100644
index 0000000000..95793e1cfb
--- /dev/null
+++ b/lib/inets/src/http_server/mod_security.erl
@@ -0,0 +1,325 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-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").
+-include("httpd_internal.hrl").
+
+-define(VMODULE,"SEC").
+
+
+%% do/1
+do(Info) ->
+ ?hdrt("do", [{info, Info}]),
+ %% Check and see if any user has been authorized.
+ case proplists:get_value(remote_user, Info#mod.data,not_defined_user) of
+ not_defined_user ->
+ %% No user has been authorized.
+ case proplists:get_value(response, Info#mod.data) of
+ %% A status code has been generated!
+ {401, _Response} ->
+ case proplists:get_value("authorization",
+ Info#mod.parsed_header) 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!
+ DecodedString =
+ case (catch
+ base64:decode_to_string(
+ EncodedString)) of
+ %% Decode failed
+ {'EXIT',{function_clause, _}} ->
+ EncodedString;
+ String ->
+ String
+ end,
+
+ report_failed(Info, DecodedString,
+ "Failed authentication"),
+ take_failed_action(Info, DecodedString),
+ {proceed, Info#mod.data}
+ end;
+ _ ->
+ {proceed, Info#mod.data}
+ end;
+ User ->
+ %% A user has been authenticated, now is he blocked ?
+ 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),
+ case mod_security_server:check_blocked_user(Info, User,
+ SDirData,
+ Addr, Port) of
+ true ->
+ report_failed(Info, User ,"User Blocked"),
+ {proceed, [{status, {403, Info#mod.request_uri, ""}} |
+ Info#mod.data]};
+ false ->
+ report_failed(Info, User,"Authentication Succedded"),
+ mod_security_server:store_successful_auth(Addr, Port,
+ User,
+ SDirData),
+ {proceed, Info#mod.data}
+ end
+ end.
+
+report_failed(Info, Auth, Event) ->
+ Request = Info#mod.request_line,
+ {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+ String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++
+ " : " ++ Auth,
+ mod_disk_log:security_log(Info,String),
+ mod_log:security_log(Info, String).
+
+take_failed_action(Info, Auth) ->
+ ?hdrd("take failed action", [{auth, Auth}]),
+ 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),
+ mod_security_server:store_failed_auth(Info, Addr, Port,
+ Auth, SDirData).
+
+secretp(Path, ConfigDB) ->
+ Directories = ets:match(ConfigDB,{directory,{'$1','_'}}),
+ case secret_path(Path, Directories) of
+ {yes, Directory} ->
+ ?hdrd("secretp - yes", [{dir, Directory}]),
+ SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory),
+ [SDir] = lists:filter(fun({Directory0, _})
+ when Directory0 == Directory ->
+ true;
+ (_) ->
+ false
+ end, SDirs0),
+ SDir;
+ 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, [], Dir) ->
+ {yes, Dir};
+secret_path(Path, [[NewDir]|Rest], Dir) ->
+ case inets_regexp:match(Path, NewDir) of
+ {match, _, _} when Dir =:= to_be_found ->
+ secret_path(Path, Rest, NewDir);
+ {match, _, Length} when Length > length(Dir) ->
+ secret_path(Path, Rest, NewDir);
+ {match, _, _} ->
+ secret_path(Path, Rest, Dir);
+ nomatch ->
+ secret_path(Path, Rest, Dir)
+ end.
+
+
+load("<Directory " ++ Directory, []) ->
+ ?hdrt("load security directory - begin", [{directory, 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("SecurityDataFile " ++ FileName,
+ [{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory",
+ [{file, FileName}, {dir, Dir}, {dir_data, DirData}]),
+ File = httpd_conf:clean(FileName),
+ {ok, [{security_directory, {Dir, [{data_file, File}|DirData]}}]};
+load("SecurityCallbackModule " ++ ModuleName,
+ [{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory",
+ [{module, ModuleName}, {dir, Dir}, {dir_data, DirData}]),
+ Mod = list_to_atom(httpd_conf:clean(ModuleName)),
+ {ok, [{security_directory, {Dir, [{callback_module, Mod}|DirData]}}]};
+load("SecurityMaxRetries " ++ Retries,
+ [{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory",
+ [{max_retries, Retries}, {dir, Dir}, {dir_data, DirData}]),
+ load_return_int_tag("SecurityMaxRetries", max_retries,
+ httpd_conf:clean(Retries), Dir, DirData);
+load("SecurityBlockTime " ++ Time,
+ [{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory",
+ [{block_time, Time}, {dir, Dir}, {dir_data, DirData}]),
+ load_return_int_tag("SecurityBlockTime", block_time,
+ httpd_conf:clean(Time), Dir, DirData);
+load("SecurityFailExpireTime " ++ Time,
+ [{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory",
+ [{expire_time, Time}, {dir, Dir}, {dir_data, DirData}]),
+ load_return_int_tag("SecurityFailExpireTime", fail_expire_time,
+ httpd_conf:clean(Time), Dir, DirData);
+load("SecurityAuthTimeout " ++ Time0,
+ [{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory",
+ [{auth_timeout, Time0}, {dir, Dir}, {dir_data, DirData}]),
+ Time = httpd_conf:clean(Time0),
+ load_return_int_tag("SecurityAuthTimeout", auth_timeout,
+ httpd_conf:clean(Time), Dir, DirData);
+load("AuthName " ++ Name0,
+ [{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory",
+ [{name, Name0}, {dir, Dir}, {dir_data, DirData}]),
+ Name = httpd_conf:clean(Name0),
+ {ok, [{security_directory, {Dir, [{auth_name, Name}|DirData]}}]};
+load("</Directory>",[{security_directory, {Dir, DirData}}]) ->
+ ?hdrt("load security directory - end",
+ [{dir, Dir}, {dir_data, DirData}]),
+ {ok, [], {security_directory, {Dir, 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, {Dir, DirData}}, ConfigList)
+ when is_list(Dir) andalso is_list(DirData) ->
+ ?hdrt("store security directory", [{dir, Dir}, {dir_data, DirData}]),
+ Addr = proplists:get_value(bind_address, ConfigList),
+ Port = proplists:get_value(port, ConfigList),
+ mod_security_server:start(Addr, Port),
+ SR = proplists:get_value(server_root, ConfigList),
+ case proplists:get_value(data_file, DirData, no_data_file) of
+ no_data_file ->
+ {error, {missing_security_data_file, {security_directory, {Dir, DirData}}}};
+ 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, {Dir, NewDirData1}}};
+ {error, Err} ->
+ {error, {{open_data_file, DataFile}, Err}}
+ end
+ end;
+store({directory, {Directory, DirData}}, _) ->
+ {error, {wrong_type, {security_directory, {Directory, DirData}}}}.
+
+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 is_integer(Port) ->
+ list_blocked_users(undefined,Port,Dir);
+list_blocked_users(Addr, Port) when is_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 is_integer(Port) ->
+ unblock_user(User, undefined, Port, Dir);
+unblock_user(User, Addr, Port) when is_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 is_integer(Port) ->
+ list_auth_users(undefined, Port, Dir);
+list_auth_users(Addr, Port) when is_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).
diff --git a/lib/inets/src/http_server/mod_security_server.erl b/lib/inets/src/http_server/mod_security_server.erl
new file mode 100644
index 0000000000..58060686b3
--- /dev/null
+++ b/lib/inets/src/http_server/mod_security_server.erl
@@ -0,0 +1,665 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% 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_internal.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/2, init/1,
+ handle_info/2, handle_call/3, handle_cast/2,
+ terminate/2,
+ code_change/3]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% External API %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% start_link/3
+%%
+%% NOTE: This is called by httpd_misc_sup when the process is started
+%%
+
+start_link(Addr, Port) ->
+ ?hdrt("start_link", [{address, Addr}, {port, Port}]),
+ Name = make_name(Addr, Port),
+ gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]).
+
+
+%% start/2
+%% Called by the mod_security module.
+
+start(Addr, Port) ->
+ ?hdrt("start", [{address, Addr}, {port, Port}]),
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined ->
+ httpd_misc_sup:start_sec_server(Addr, Port);
+ _ -> %% Already started...
+ ok
+ end.
+
+
+%% stop
+
+stop(Port) ->
+ stop(undefined, Port).
+stop(Addr, Port) ->
+ ?hdrt("stop", [{address, Addr}, {port, Port}]),
+ Name = make_name(Addr, Port),
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _ ->
+ httpd_misc_sup:stop_sec_server(Addr, Port)
+ end.
+
+
+addr(undefined) ->
+ any;
+addr(Addr) ->
+ Addr.
+
+
+%% list_blocked_users
+
+list_blocked_users(Addr, Port) ->
+ Name = make_name(Addr, Port),
+ Req = {list_blocked_users, addr(Addr), Port, '_'},
+ call(Name, Req).
+
+list_blocked_users(Addr, Port, Dir) ->
+ Name = make_name(Addr, Port),
+ Req = {list_blocked_users, addr(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(Addr), Port, Dir, Time},
+ call(Name, Req).
+
+
+%% unblock_user
+
+unblock_user(User, Addr, Port) ->
+ Name = make_name(Addr, Port),
+ Req = {unblock_user, User, addr(Addr), Port, '_'},
+ call(Name, Req).
+
+unblock_user(User, Addr, Port, Dir) ->
+ Name = make_name(Addr, Port),
+ Req = {unblock_user, User, addr(Addr), Port, Dir},
+ call(Name, Req).
+
+
+%% list_auth_users
+
+list_auth_users(Addr, Port) ->
+ Name = make_name(Addr, Port),
+ Req = {list_auth_users, addr(Addr), Port, '_'},
+ call(Name, Req).
+
+list_auth_users(Addr, Port, Dir) ->
+ Name = make_name(Addr,Port),
+ Req = {list_auth_users, addr(Addr), Port, Dir},
+ call(Name, Req).
+
+
+%% new_table
+
+new_table(Addr, Port, TabName) ->
+ Name = make_name(Addr,Port),
+ Req = {new_table, addr(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) ->
+ ?hdrv("store failed auth",
+ [{addr, Addr}, {port, Port},
+ {decoded_string, DecodedString}, {sdir_data, 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(_) ->
+ ?hdrv("initiating", []),
+ process_flag(trap_exit, true),
+ {ok, []}.
+
+handle_call(stop, _From, _Tables) ->
+ {stop, normal, ok, []};
+
+handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) ->
+ ?hdrv("block user",
+ [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir},
+ {time, Time}]),
+ Ret = block_user_int(User, Addr, Port, Dir, Time),
+ {reply, Ret, Tables};
+
+handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) ->
+ ?hdrv("list blocked users",
+ [{addr, Addr}, {port, Port}, {dir, Dir}]),
+ Blocked = list_blocked(Tables, Addr, Port, Dir, []),
+ {reply, Blocked, Tables};
+
+handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) ->
+ ?hdrv("block user",
+ [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}]),
+ Ret = unblock_user_int(User, Addr, Port, Dir),
+ {reply, Ret, Tables};
+
+handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) ->
+ ?hdrv("list auth users",
+ [{addr, Addr}, {port, Port}, {dir, Dir}]),
+ Auth = list_auth(Tables, Addr, Port, Dir, []),
+ {reply, Auth, Tables};
+
+handle_call({new_table, Addr, Port, Name}, _From, Tables) ->
+ case lists:keysearch(Name, 1, Tables) of
+ {value, {Name, {Ets, Dets}}} ->
+ {reply, {ok, {Ets, Dets}}, Tables};
+ false ->
+ TName = make_name(Addr,Port,length(Tables)),
+ 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],
+ {reply, {ok, {ETS, DFile}}, NewTables};
+ {error, Err} ->
+ {reply, {error, {create_dets, Err}}, Tables}
+ end
+ end;
+
+handle_call(delete_tables, _From, 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) ->
+ {ETS, DETS} = proplists:get_value(data_file, SDirData),
+ Dir = proplists:get_value(path, SDirData),
+ Addr = proplists:get_value(bind_address, SDirData),
+ Port = proplists:get_value(port, SDirData),
+ CBModule =
+ proplists:get_value(callback_module, SDirData, no_module_at_all),
+ Ret =
+ check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
+ {reply, Ret, Tables};
+
+handle_call(_Request,_From,Tables) ->
+ {reply,ok,Tables}.
+
+
+%% handle_cast
+
+handle_cast({store_failed_auth, [_, _, []]}, Tables) ->
+ %% Some other authentication scheme than mod_auth (example mod_htacess)
+ %% was the source for the authentication failure so we should ignor it!
+ {noreply, Tables};
+handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) ->
+ {ETS, DETS} = proplists:get_value(data_file, SDirData),
+ Dir = proplists:get_value(path, SDirData),
+ Addr = proplists:get_value(bind_address, SDirData),
+ Port = proplists:get_value(port, SDirData),
+ {ok, [User,Password]} = httpd_util:split(DecodedString,":",2),
+ Seconds = universal_time(),
+ Key = {User, Dir, Addr, Port},
+ %% Event
+ CBModule = proplists:get_value(callback_module,
+ SDirData, no_module_at_all),
+ 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..
+ case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
+ [] ->
+ no;
+ List ->
+ ExpireTime = proplists:get_value(fail_expire_time,
+ SDirData, 30)*60,
+ lists:map(fun({failed, {TheKey, LS, Gen}}) ->
+ Diff = Seconds-LS,
+ if
+ Diff > ExpireTime ->
+ ets:match_delete(ETS,
+ {failed,
+ {TheKey, LS, Gen}}),
+ dets:match_delete(DETS,
+ {failed,
+ {TheKey, LS, Gen}});
+ true ->
+ ok
+ end
+ end,
+ List)
+ end,
+
+ %% Insert the new failure..
+ Generation = length(ets:match_object(ETS, {failed, {Key, '_', '_'}})),
+ ets:insert(ETS, {failed, {Key, Seconds, Generation}}),
+ dets:insert(DETS, {failed, {Key, Seconds, Generation}}),
+
+ %% See if we should block this user..
+ MaxRetries = proplists:get_value(max_retries, SDirData, 3),
+ BlockTime = proplists:get_value(block_time, SDirData, 60),
+ case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
+ List1 when length(List1) >= MaxRetries ->
+ %% Block this user until Future
+ Future = Seconds+BlockTime*60,
+ 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, '_', '_'}});
+ _ ->
+ no
+ end,
+ {noreply, Tables};
+
+handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) ->
+ {ETS, DETS} = proplists:get_value(data_file, SDirData),
+ AuthTimeOut = proplists:get_value(auth_timeout, SDirData, 30),
+ Dir = proplists:get_value(path, SDirData),
+ 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) ->
+ error_msg("security server got unknown cast: ~p",[Req]),
+ {noreply, Tables}.
+
+
+%% handle_info
+
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+
+%% terminate
+
+terminate(_Reason, _Tables) ->
+ ok.
+
+
+%% code_change({down, ToVsn}, State, Extra)
+%%
+code_change({down, _}, State, _Extra) ->
+ {ok, State};
+
+
+%% code_change(FromVsn, State, Extra)
+%%
+code_change(_, State, _Extra) ->
+ {ok, State}.
+
+%% block_user_int/5
+block_user_int(User, Addr, Port, Dir, Time) ->
+ Dirs = httpd_manager:config_match(Addr, Port,
+ {security_directory, {'_', '_'}}),
+ 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 = proplists:get_value(callback_module, DirData,
+ no_module_at_all),
+ 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/4
+unblock_user_int(User, Addr, Port, Dir) ->
+ Dirs = httpd_manager:config_match(Addr, Port,
+ {security_directory, {'_', '_'}}),
+ case find_dirdata(Dirs, Dir) of
+ {ok, DirData, {ETS, DETS}} ->
+ case ets:match_object(ETS,
+ {blocked_user,{User,Addr,Port,Dir,'_'}}) of
+ [] ->
+ {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 = proplists:get_value(callback_module,
+ DirData,
+ no_module_at_all),
+ user_unblock_event(CBModule,Addr,Port,Dir,User),
+ true
+ end;
+ _ ->
+ {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 ->
+ 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)
+ end.
+
+
+%% list_blocked/2
+
+list_blocked([], _Addr, _Port, _Dir, Acc) ->
+ ?hdrv("list blocked", [{acc, 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) ->
+ ?hdrv("list blocked", [{ets, ETS}, {tab2list, ets:tab2list(ETS)}]),
+ List = ets:match_object(ETS, {blocked_user,
+ {'_',Addr,Port,Dir,'_'}}),
+
+ NewBlocked = lists:foldl(fun({blocked_user, X}, A) ->
+ [X|A] end, Acc, List),
+
+ 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(),
+ BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}),
+ Blocked = lists:foldl(fun({blocked_user, X}, A) ->
+ [X|A] end, [], BlockList),
+ check_blocked_user(Info,User,Dir,
+ Addr,Port,ETS,DETS,TN,Blocked,CBModule).
+
+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}| _], 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) ->
+ ?hdrt("event",
+ [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]),
+ (catch Mod:event(Event,Port,Dir,Info));
+event(Event, Mod, any, Port, Dir, Info) ->
+ ?hdrt("event",
+ [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]),
+ (catch Mod:event(Event,Port,Dir,Info));
+event(Event, Mod, Addr, Port, Dir, Info) ->
+ ?hdrt("event",
+ [{event, Event}, {mod, Mod},
+ {addr, Addr}, {port, Port}, {dir, Dir}]),
+ (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/inets/src/http_server/mod_trace.erl b/lib/inets/src/http_server/mod_trace.erl
new file mode 100644
index 0000000000..df482228d8
--- /dev/null
+++ b/lib/inets/src/http_server/mod_trace.erl
@@ -0,0 +1,89 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(mod_trace).
+
+-export([do/1]).
+
+-include("httpd.hrl").
+
+
+do(Info) ->
+ %%?vtrace("do",[]),
+ case Info#mod.method of
+ "TRACE" ->
+ case 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(Info#mod.request_line ++ 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]).
+
+
+
+%%----------------------------------------------------------------------
+%%Function that controls whether a response is generated or not
+%%----------------------------------------------------------------------
+response_generated(Info)->
+ case proplists:get_value(status, Info#mod.data) of
+ %% A status code has been generated!
+ {_StatusCode,_PhraseArgs,_Reason}->
+ true;
+ %%No status code control repsonsxe
+ undefined ->
+ case proplists:get_value(response, Info#mod.data) of
+ %% No response has been generated!
+ undefined ->
+ false;
+ %% A response has been generated or sent!
+ _Response ->
+ true
+ end
+ end.
+