aboutsummaryrefslogtreecommitdiffstats
path: root/lib/inets/src/http_server/httpd_conf.erl
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/httpd_conf.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/inets/src/http_server/httpd_conf.erl')
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl1119
1 files changed, 1119 insertions, 0 deletions
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]).