diff options
author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
---|---|---|
committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/inets/src | |
download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/inets/src')
91 files changed, 28344 insertions, 0 deletions
diff --git a/lib/inets/src/Makefile b/lib/inets/src/Makefile new file mode 100644 index 0000000000..dd18e92107 --- /dev/null +++ b/lib/inets/src/Makefile @@ -0,0 +1,35 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-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 +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +include subdirs.mk + +SPECIAL_TARGETS = + +# ---------------------------------------------------- +# Default Subdir Targets +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_subdir.mk + diff --git a/lib/inets/src/ftp/Makefile b/lib/inets/src/ftp/Makefile new file mode 100644 index 0000000000..70d51115e6 --- /dev/null +++ b/lib/inets/src/ftp/Makefile @@ -0,0 +1,99 @@ +# +# %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 = \ + ftp \ + ftp_progress \ + ftp_response \ + ftp_sup + +HRL_FILES = ftp_internal.hrl + +ERL_FILES = $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# INETS FLAGS +# ---------------------------------------------------- +INETS_FLAGS = -D'SERVER_SOFTWARE="inets/$(VSN)"' + +ifeq ($(FTP_DEBUG),true) + INETS_FLAGS += -Dftp_debug +endif + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +INETS_ERL_FLAGS += -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/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl new file mode 100644 index 0000000000..534fcae675 --- /dev/null +++ b/lib/inets/src/ftp/ftp.erl @@ -0,0 +1,2009 @@ +%% +%% %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: This module implements an ftp client, RFC 959. +%% It also supports ipv6 RFC 2428. + +-module(ftp). + +-behaviour(gen_server). +-behaviour(inets_service). + +-deprecated({open, 3, next_major_release}). +-deprecated({force_active, 1, next_major_release}). + +%% API - Client interface +-export([cd/2, close/1, delete/2, formaterror/1, + lcd/2, lpwd/1, ls/1, ls/2, + mkdir/2, nlist/1, nlist/2, + open/1, open/2, open/3, force_active/1, + pwd/1, quote/2, + recv/2, recv/3, recv_bin/2, + recv_chunk_start/2, recv_chunk/1, + rename/3, rmdir/2, + send/2, send/3, send_bin/3, + send_chunk_start/2, send_chunk/2, send_chunk_end/1, + type/2, user/3, user/4, account/2, + append/3, append/2, append_bin/3, + append_chunk/2, append_chunk_end/1, append_chunk_start/2, info/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +%% supervisor callbacks +-export([start_link/1, start_link/2]). + +%% Behavior callbacks +-export([start_standalone/1, start_service/1, + stop_service/1, services/0, service_info/1]). + +-include("ftp_internal.hrl"). + +%% Constante used in internal state definition +-define(CONNECTION_TIMEOUT, 60*1000). +-define(DEFAULT_MODE, passive). +-define(PROGRESS_DEFAULT, ignore). + +%% Internal Constants +-define(FTP_PORT, 21). +-define(FILE_BUFSIZE, 4096). + +%% Internal state +-record(state, { + csock = undefined, % socket() - Control connection socket + dsock = undefined, % socket() - Data connection socket + verbose = false, % boolean() + ldir = undefined, % string() - Current local directory + type = ftp_server_default, % atom() - binary | ascii + chunk = false, % boolean() - Receiving data chunks + mode = ?DEFAULT_MODE, % passive | active + timeout = ?CONNECTION_TIMEOUT, % integer() + %% Data received so far on the data connection + data = <<>>, % binary() + %% Data received so far on the control connection + %% {BinStream, AccLines}. If a binary sequence + %% ends with ?CR then keep it in the binary to + %% be able to detect if the next received byte is ?LF + %% and hence the end of the response is reached! + ctrl_data = {<<>>, [], start}, % {binary(), [bytes()], LineStatus} + %% pid() - Client pid (note not the same as "From") + owner = undefined, + client = undefined, % "From" to be used in gen_server:reply/2 + %% Function that activated a connection and maybe some + %% data needed further on. + caller = undefined, % term() + ipfamily, % inet | inet6 | inet6fb4 + progress = ignore % ignore | pid() + }). + + +%%%========================================================================= +%%% API - CLIENT FUNCTIONS +%%%========================================================================= + +%%-------------------------------------------------------------------------- +%% open(HostOrOtpList, <Port>, <Flags>) -> {ok, Pid} | {error, ehost} +%% HostOrOtpList = string() | [{option_list, Options}] +%% Port = integer(), +%% Flags = [Flag], +%% Flag = verbose | debug | trace +%% +%% Description: Start an ftp client and connect to a host. +%%-------------------------------------------------------------------------- + +%% <BACKWARD-COMPATIBILLITY> +open({option_list, Options}) when is_list(Options) -> + try + {ok, StartOptions} = start_options(Options), + {ok, OpenOptions} = open_options(Options), + case ftp_sup:start_child([[[{client, self()} | StartOptions], []]]) of + {ok, Pid} -> + call(Pid, {open, ip_comm, OpenOptions}, plain); + Error1 -> + Error1 + end + catch + throw:Error2 -> + Error2 + end; +%% </BACKWARD-COMPATIBILLITY> + +open(Host) -> + open(Host, []). + +%% <BACKWARD-COMPATIBILLITY> +open(Host, Port) when is_integer(Port) -> + open(Host, [{port, Port}]); +%% </BACKWARD-COMPATIBILLITY> + +%% <BACKWARD-COMPATIBILLITY> +open(Host, [H|_] = Flags) when is_atom(H) -> + open(Host, ?FTP_PORT, Flags); +%% </BACKWARD-COMPATIBILLITY> + +open(Host, Opts) when is_list(Opts) -> + ?fcrt("open", [{host, Host}, {opts, Opts}]), + try + {ok, StartOptions} = start_options(Opts), + ?fcrt("open", [{start_options, StartOptions}]), + {ok, OpenOptions} = open_options([{host, Host}|Opts]), + ?fcrt("open", [{open_options, OpenOptions}]), + case start_link(StartOptions, []) of + {ok, Pid} -> + ?fcrt("open - ok", [{pid, Pid}]), + call(Pid, {open, ip_comm, OpenOptions}, plain); + Error1 -> + ?fcrt("open - error", [{error1, Error1}]), + Error1 + end + catch + throw:Error2 -> + ?fcrt("open - error", [{error2, Error2}]), + Error2 + end. + + +%% <BACKWARD-COMPATIBILLITY> +open(Host, Port, Flags) when is_integer(Port) andalso is_list(Flags) -> + ?fcrt("open", [{host, Host}, {port, Port}, {flags, Flags}]), + try + {ok, StartOptions} = start_options([{flags, Flags}]), + ?fcrt("open", [{start_options, StartOptions}]), + {ok, OpenOptions} = open_options([{host, Host}, {port, Port}|Flags]), + ?fcrt("open", [{open_options, OpenOptions}]), + case ftp_sup:start_child([[{client, self()} | StartOptions], []]) of + {ok, Pid} -> + ?fcrt("open - ok", [{pid, Pid}]), + call(Pid, {open, ip_comm, OpenOptions}, plain); + Error1 -> + ?fcrt("open - error", [{error1, Error1}]), + Error1 + end + catch + throw:Error2 -> + Error2 + end. +%% </BACKWARD-COMPATIBILLITY> + + + + + +%%-------------------------------------------------------------------------- +%% user(Pid, User, Pass, <Acc>) -> ok | {error, euser} | {error, econn} +%% | {error, eacct} +%% Pid = pid(), +%% User = Pass = Acc = string() +%% +%% Description: Login with or without a supplied account name. +%%-------------------------------------------------------------------------- +user(Pid, User, Pass) -> + call(Pid, {user, User, Pass}, atom). + +user(Pid, User, Pass, Acc) -> + call(Pid, {user, User, Pass, Acc}, atom). + +%%-------------------------------------------------------------------------- +%% account(Pid, Acc) -> ok | {error, eacct} +%% Pid = pid() +%% Acc= string() +%% +%% Description: Set a user Account. +%%-------------------------------------------------------------------------- +account(Pid, Acc) -> + call(Pid, {account, Acc}, atom). + +%%-------------------------------------------------------------------------- +%% pwd(Pid) -> {ok, Dir} | {error, elogin} | {error, econn} +%% Pid = pid() +%% Dir = string() +%% +%% Description: Get the current working directory at remote server. +%%-------------------------------------------------------------------------- +pwd(Pid) -> + call(Pid, pwd, ctrl). + +%%-------------------------------------------------------------------------- +%% lpwd(Pid) -> {ok, Dir} | {error, elogin} +%% Pid = pid() +%% Dir = string() +%% +%% Description: Get the current working directory at local server. +%%-------------------------------------------------------------------------- +lpwd(Pid) -> + call(Pid, lpwd, string). + +%%-------------------------------------------------------------------------- +%% cd(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn} +%% Pid = pid() +%% Dir = string() +%% +%% Description: Change current working directory at remote server. +%%-------------------------------------------------------------------------- +cd(Pid, Dir) -> + call(Pid, {cd, Dir}, atom). + +%%-------------------------------------------------------------------------- +%% lcd(Pid, Dir) -> ok | {error, epath} +%% Pid = pid() +%% Dir = string() +%% +%% Description: Change current working directory for the local client. +%%-------------------------------------------------------------------------- +lcd(Pid, Dir) -> + call(Pid, {lcd, Dir}, string). + +%%-------------------------------------------------------------------------- +%% ls(Pid) -> Result +%% ls(Pid, <Dir>) -> Result +%% +%% Pid = pid() +%% Dir = string() +%% Result = {ok, Listing} | {error, Reason} +%% Listing = string() +%% Reason = epath | elogin | econn +%% +%% Description: Returns a list of files in long format. +%%-------------------------------------------------------------------------- +ls(Pid) -> + ls(Pid, ""). +ls(Pid, Dir) -> + call(Pid, {dir, long, Dir}, string). + +%%-------------------------------------------------------------------------- +%% nlist(Pid) -> Result +%% nlist(Pid, Pathname) -> Result +%% +%% Pid = pid() +%% Pathname = string() +%% Result = {ok, Listing} | {error, Reason} +%% Listing = string() +%% Reason = epath | elogin | econn +%% +%% Description: Returns a list of files in short format +%%-------------------------------------------------------------------------- +nlist(Pid) -> + nlist(Pid, ""). +nlist(Pid, Dir) -> + call(Pid, {dir, short, Dir}, string). + +%%-------------------------------------------------------------------------- +%% rename(Pid, CurrFile, NewFile) -> ok | {error, epath} | {error, elogin} +%% | {error, econn} +%% Pid = pid() +%% CurrFile = NewFile = string() +%% +%% Description: Rename a file at remote server. +%%-------------------------------------------------------------------------- +rename(Pid, CurrFile, NewFile) -> + call(Pid, {rename, CurrFile, NewFile}, string). + +%%-------------------------------------------------------------------------- +%% delete(Pid, File) -> ok | {error, epath} | {error, elogin} | +%% {error, econn} +%% Pid = pid() +%% File = string() +%% +%% Description: Remove file at remote server. +%%-------------------------------------------------------------------------- +delete(Pid, File) -> + call(Pid, {delete, File}, string). + +%%-------------------------------------------------------------------------- +%% mkdir(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn} +%% Pid = pid(), +%% Dir = string() +%% +%% Description: Make directory at remote server. +%%-------------------------------------------------------------------------- +mkdir(Pid, Dir) -> + call(Pid, {mkdir, Dir}, atom). + +%%-------------------------------------------------------------------------- +%% rmdir(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn} +%% Pid = pid(), +%% Dir = string() +%% +%% Description: Remove directory at remote server. +%%-------------------------------------------------------------------------- +rmdir(Pid, Dir) -> + call(Pid, {rmdir, Dir}, atom). + +%%-------------------------------------------------------------------------- +%% type(Pid, Type) -> ok | {error, etype} | {error, elogin} | {error, econn} +%% Pid = pid() +%% Type = ascii | binary +%% +%% Description: Set transfer type. +%%-------------------------------------------------------------------------- +type(Pid, Type) -> + call(Pid, {type, Type}, atom). + +%%-------------------------------------------------------------------------- +%% recv(Pid, RemoteFileName <LocalFileName>) -> ok | {error, epath} | +%% {error, elogin} | {error, econn} +%% Pid = pid() +%% RemoteFileName = LocalFileName = string() +%% +%% Description: Transfer file from remote server. +%%-------------------------------------------------------------------------- +recv(Pid, RemotFileName) -> + recv(Pid, RemotFileName, RemotFileName). + +recv(Pid, RemotFileName, LocalFileName) -> + call(Pid, {recv, RemotFileName, LocalFileName}, atom). + +%%-------------------------------------------------------------------------- +%% recv_bin(Pid, RemoteFile) -> {ok, Bin} | {error, epath} | {error, elogin} +%% | {error, econn} +%% Pid = pid() +%% RemoteFile = string() +%% Bin = binary() +%% +%% Description: Transfer file from remote server into binary. +%%-------------------------------------------------------------------------- +recv_bin(Pid, RemoteFile) -> + call(Pid, {recv_bin, RemoteFile}, bin). + +%%-------------------------------------------------------------------------- +%% recv_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} | {error, epath} +%% | {error, econn} +%% Pid = pid() +%% RemoteFile = string() +%% +%% Description: Start receive of chunks of remote file. +%%-------------------------------------------------------------------------- +recv_chunk_start(Pid, RemoteFile) -> + call(Pid, {recv_chunk_start, RemoteFile}, atom). + +%%-------------------------------------------------------------------------- +%% recv_chunk(Pid, RemoteFile) -> ok | {ok, Bin} | {error, Reason} +%% Pid = pid() +%% RemoteFile = string() +%% +%% Description: Transfer file from remote server into binary in chunks +%%-------------------------------------------------------------------------- +recv_chunk(Pid) -> + call(Pid, recv_chunk, atom). + +%%-------------------------------------------------------------------------- +%% send(Pid, LocalFileName <RemotFileName>) -> ok | {error, epath} +%% | {error, elogin} +%% | {error, econn} +%% Pid = pid() +%% LocalFileName = RemotFileName = string() +%% +%% Description: Transfer file to remote server. +%%-------------------------------------------------------------------------- +send(Pid, LocalFileName) -> + send(Pid, LocalFileName, LocalFileName). + +send(Pid, LocalFileName, RemotFileName) -> + call(Pid, {send, LocalFileName, RemotFileName}, atom). + +%%-------------------------------------------------------------------------- +%% send_bin(Pid, Bin, RemoteFile) -> ok | {error, epath} | {error, elogin} +%% | {error, enotbinary} | {error, econn} +%% Pid = pid() +%% Bin = binary() +%% RemoteFile = string() +%% +%% Description: Transfer a binary to a remote file. +%%-------------------------------------------------------------------------- +send_bin(Pid, Bin, RemoteFile) when is_binary(Bin) -> + call(Pid, {send_bin, Bin, RemoteFile}, atom); +send_bin(_Pid, _Bin, _RemoteFile) -> + {error, enotbinary}. + +%%-------------------------------------------------------------------------- +%% send_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} | {error, epath} +%% | {error, econn} +%% Pid = pid() +%% RemoteFile = string() +%% +%% Description: Start transfer of chunks to remote file. +%%-------------------------------------------------------------------------- +send_chunk_start(Pid, RemoteFile) -> + call(Pid, {send_chunk_start, RemoteFile}, atom). + +%%-------------------------------------------------------------------------- +%% append_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} | +%% {error, epath} | {error, econn} +%% Pid = pid() +%% RemoteFile = string() +%% +%% Description: Start append chunks of data to remote file. +%%-------------------------------------------------------------------------- +append_chunk_start(Pid, RemoteFile) -> + call(Pid, {append_chunk_start, RemoteFile}, atom). + +%%-------------------------------------------------------------------------- +%% send_chunk(Pid, Bin) -> ok | {error, elogin} | {error, enotbinary} +%% | {error, echunk} | {error, econn} +%% Pid = pid() +%% Bin = binary(). +%% +%% Purpose: Send chunk to remote file. +%%-------------------------------------------------------------------------- +send_chunk(Pid, Bin) when is_binary(Bin) -> + call(Pid, {transfer_chunk, Bin}, atom); +send_chunk(_Pid, _Bin) -> + {error, enotbinary}. + +%%-------------------------------------------------------------------------- +%% append_chunk(Pid, Bin) -> ok | {error, elogin} | {error, enotbinary} +%% | {error, echunk} | {error, econn} +%% Pid = pid() +%% Bin = binary() +%% +%% Description: Append chunk to remote file. +%%-------------------------------------------------------------------------- +append_chunk(Pid, Bin) when is_binary(Bin) -> + call(Pid, {transfer_chunk, Bin}, atom); +append_chunk(_Pid, _Bin) -> + {error, enotbinary}. + +%%-------------------------------------------------------------------------- +%% send_chunk_end(Pid) -> ok | {error, elogin} | {error, echunk} +%% | {error, econn} +%% Pid = pid() +%% +%% Description: End sending of chunks to remote file. +%%-------------------------------------------------------------------------- +send_chunk_end(Pid) -> + call(Pid, chunk_end, atom). + +%%-------------------------------------------------------------------------- +%% append_chunk_end(Pid) -> ok | {error, elogin} | {error, echunk} +%% | {error, econn} +%% Pid = pid() +%% +%% Description: End appending of chunks to remote file. +%%-------------------------------------------------------------------------- +append_chunk_end(Pid) -> + call(Pid, chunk_end, atom). + +%%-------------------------------------------------------------------------- +%% append(Pid, LocalFileName, RemotFileName) -> ok | {error, epath} +%% | {error, elogin} | {error, econn} +%% Pid = pid() +%% LocalFileName = RemotFileName = string() +%% +%% Description: Append the local file to the remote file +%%-------------------------------------------------------------------------- +append(Pid, LocalFileName) -> + append(Pid, LocalFileName, LocalFileName). + +append(Pid, LocalFileName, RemotFileName) -> + call(Pid, {append, LocalFileName, RemotFileName}, atom). + +%%-------------------------------------------------------------------------- +%% append_bin(Pid, Bin, RemoteFile) -> ok | {error, epath} | {error, elogin} +%% | {error, enotbinary} | {error, econn} +%% Pid = pid() +%% Bin = binary() +%% RemoteFile = string() +%% +%% Purpose: Append a binary to a remote file. +%%-------------------------------------------------------------------------- +append_bin(Pid, Bin, RemoteFile) when is_binary(Bin) -> + call(Pid, {append_bin, Bin, RemoteFile}, atom); +append_bin(_Pid, _Bin, _RemoteFile) -> + {error, enotbinary}. + +%%-------------------------------------------------------------------------- +%% quote(Pid, Cmd) -> ok +%% Pid = pid() +%% Cmd = string() +%% +%% Description: Send arbitrary ftp command. +%%-------------------------------------------------------------------------- +quote(Pid, Cmd) when is_list(Cmd) -> + call(Pid, {quote, Cmd}, atom). + +%%-------------------------------------------------------------------------- +%% close(Pid) -> ok +%% Pid = pid() +%% +%% Description: End the ftp session. +%%-------------------------------------------------------------------------- +close(Pid) -> + cast(Pid, close), + ok. + +%%-------------------------------------------------------------------------- +%% force_active(Pid) -> ok +%% Pid = pid() +%% +%% Description: Force connection to use active mode. +%%-------------------------------------------------------------------------- +force_active(Pid) -> + error_logger:info_report("This function is deprecated use the mode flag " + "instead"), + call(Pid, force_active, atom). + +%%-------------------------------------------------------------------------- +%% formaterror(Tag) -> string() +%% Tag = atom() | {error, atom()} +%% +%% Description: Return diagnostics. +%%-------------------------------------------------------------------------- +formaterror(Tag) -> + ftp_response:error_string(Tag). + +info(Pid) -> + call(Pid, info, list). + + +%%%======================================================================== +%%% Behavior callbacks +%%%======================================================================== +start_standalone(Options) -> + try + {ok, StartOptions} = start_options(Options), + {ok, OpenOptions} = open_options(Options), + case start_link(StartOptions, []) of + {ok, Pid} -> + call(Pid, {open, ip_comm, OpenOptions}, plain); + Error1 -> + Error1 + end + catch + throw:Error2 -> + Error2 + end. + +start_service(Options) -> + try + {ok, StartOptions} = start_options(Options), + {ok, OpenOptions} = open_options(Options), + case ftp_sup:start_child([[[{client, self()} | StartOptions], []]]) of + {ok, Pid} -> + call(Pid, {open, ip_comm, OpenOptions}, plain); + Error1 -> + Error1 + end + catch + throw:Error2 -> + Error2 + end. + +stop_service(Pid) -> + close(Pid). + +services() -> + [{ftpc, Pid} || {_, Pid, _, _} <- + supervisor:which_children(ftp_sup)]. +service_info(Pid) -> + {ok, Info} = call(Pid, info, list), + {ok, [proplists:lookup(mode, Info), + proplists:lookup(local_port, Info), + proplists:lookup(peer, Info), + proplists:lookup(peer_port, Info)]}. + + +%% This function extracts the start options from the +%% Valid options: +%% debug, +%% verbose +%% ipfamily +%% priority +%% flags (for backward compatibillity) +start_options(Options) -> + ?fcrt("start_options", [{options, Options}]), + case lists:keysearch(flags, 1, Options) of + {value, {flags, Flags}} -> + Verbose = lists:member(verbose, Flags), + IsTrace = lists:member(trace, Flags), + IsDebug = lists:member(debug, Flags), + DebugLevel = + if + (IsTrace =:= true) -> + trace; + IsDebug =:= true -> + debug; + true -> + disable + end, + {ok, [{verbose, Verbose}, + {debug, DebugLevel}, + {priority, low}]}; + false -> + ValidateVerbose = + fun(true) -> true; + (false) -> true; + (_) -> false + end, + ValidateDebug = + fun(trace) -> true; + (debug) -> true; + (disable) -> true; + (_) -> false + end, + ValidatePriority = + fun(low) -> true; + (normal) -> true; + (high) -> true; + (_) -> false + end, + ValidOptions = + [{verbose, ValidateVerbose, false, false}, + {debug, ValidateDebug, false, disable}, + {priority, ValidatePriority, false, low}], + validate_options(Options, ValidOptions, []) + end. + + +%% This function extracts and validates the open options from the +%% Valid options: +%% mode +%% host +%% port +%% timeout +%% progress +open_options(Options) -> + ?fcrt("open_options", [{options, Options}]), + ValidateMode = + fun(active) -> true; + (passive) -> true; + (_) -> false + end, + ValidateHost = + fun(Host) when is_list(Host) -> + true; + (Host) when is_tuple(Host) andalso + ((size(Host) =:= 4) orelse (size(Host) =:= 8)) -> + true; + (_) -> + false + end, + ValidatePort = + fun(Port) when is_integer(Port) andalso (Port > 0) -> true; + (_) -> false + end, + ValidateIpFamily = + fun(inet) -> true; + (inet6) -> true; + (inet6fb4) -> true; + (_) -> false + end, + ValidateTimeout = + fun(Timeout) when is_integer(Timeout) andalso (Timeout > 0) -> true; + (_) -> false + end, + ValidateProgress = + fun(ignore) -> + true; + ({Mod, Func, _InitProgress}) when is_atom(Mod) andalso + is_atom(Func) -> + true; + (_) -> + false + end, + ValidOptions = + [{mode, ValidateMode, false, ?DEFAULT_MODE}, + {host, ValidateHost, true, ehost}, + {port, ValidatePort, false, ?FTP_PORT}, + {ipfamily, ValidateIpFamily, false, inet}, + {timeout, ValidateTimeout, false, ?CONNECTION_TIMEOUT}, + {progress, ValidateProgress, false, ?PROGRESS_DEFAULT}], + validate_options(Options, ValidOptions, []). + +validate_options([], [], Acc) -> + ?fcrt("validate_options -> done", [{acc, Acc}]), + {ok, lists:reverse(Acc)}; +validate_options([], ValidOptions, Acc) -> + ?fcrt("validate_options -> done", + [{valid_options, ValidOptions}, {acc, Acc}]), + %% Check if any mandatory options are missing! + case [{Key, Reason} || {Key, _, true, Reason} <- ValidOptions] of + [] -> + Defaults = + [{Key, Default} || {Key, _, _, Default} <- ValidOptions], + {ok, lists:reverse(Defaults ++ Acc)}; + [{_, Reason}|_Missing] -> + throw({error, Reason}) + end; +validate_options([{Key, Value}|Options], ValidOptions, Acc) -> + ?fcrt("validate_options -> check", + [{key, Key}, {value, Value}, {acc, Acc}]), + case lists:keysearch(Key, 1, ValidOptions) of + {value, {Key, Validate, _, Default}} -> + case (catch Validate(Value)) of + true -> + ?fcrt("validate_options -> check - accept", []), + NewValidOptions = lists:keydelete(Key, 1, ValidOptions), + validate_options(Options, NewValidOptions, + [{Key, Value} | Acc]); + _ -> + ?fcrt("validate_options -> check - reject", + [{default, Default}]), + NewValidOptions = lists:keydelete(Key, 1, ValidOptions), + validate_options(Options, NewValidOptions, + [{Key, Default} | Acc]) + end; + false -> + validate_options(Options, ValidOptions, Acc) + end; +validate_options([_|Options], ValidOptions, Acc) -> + validate_options(Options, ValidOptions, Acc). + + + +%%%======================================================================== +%%% gen_server callback functions +%%%======================================================================== + +%%------------------------------------------------------------------------- +%% init(Args) -> {ok, State} | {ok, State, Timeout} | {stop, Reason} +%% Description: Initiates the erlang process that manages a ftp connection. +%%------------------------------------------------------------------------- +init(Options) -> + process_flag(trap_exit, true), + + %% Keep track of the client + {value, {client, Client}} = lists:keysearch(client, 1, Options), + erlang:monitor(process, Client), + + %% Make sure inet is started + inet_db:start(), + + %% Where are we + {ok, Dir} = file:get_cwd(), + + %% Maybe activate dbg + case key_search(debug, Options, disable) of + trace -> + dbg:tracer(), + dbg:p(all, [call]), + dbg:tpl(ftp, [{'_', [], [{return_trace}]}]), + dbg:tpl(ftp_response, [{'_', [], [{return_trace}]}]), + dbg:tpl(ftp_progress, [{'_', [], [{return_trace}]}]); + debug -> + dbg:tracer(), + dbg:p(all, [call]), + dbg:tp(ftp, [{'_', [], [{return_trace}]}]), + dbg:tp(ftp_response, [{'_', [], [{return_trace}]}]), + dbg:tp(ftp_progress, [{'_', [], [{return_trace}]}]); + _ -> + %% Keep silent + ok + end, + + %% Verbose? + Verbose = key_search(verbose, Options, false), + + %% IpFamily? + IpFamily = key_search(ipfamily, Options, inet), + + State = #state{owner = Client, + verbose = Verbose, + ipfamily = IpFamily, + ldir = Dir}, + + %% Set process prio + Priority = key_search(priority, Options, low), + process_flag(priority, Priority), + + %% And we are done + {ok, State}. + + +%%-------------------------------------------------------------------------- +%% handle_call(Request, From, State) -> {reply, Reply, State} | +%% {reply, Reply, State, Timeout} | +%% {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, Reply, State} | +%% Description: Handle incoming requests. +%%------------------------------------------------------------------------- + +%% Anyone can ask this question +handle_call({_, info}, _, #state{verbose = Verbose, + mode = Mode, + timeout = Timeout, + ipfamily = IpFamily, + csock = Socket, + progress = Progress} = State) -> + {ok, {_, LocalPort}} = inet:sockname(Socket), + {ok, {Address, Port}} = inet:peername(Socket), + Options = [{verbose, Verbose}, + {ipfamily, IpFamily}, + {mode, Mode}, + {peer, Address}, + {peer_port, Port}, + {local_port, LocalPort}, + {timeout, Timeout}, + {progress, Progress}], + {reply, {ok, Options}, State}; + +%% But everything else must come from the owner +handle_call({Pid, _}, _, #state{owner = Owner} = State) when Owner =/= Pid -> + {reply, {error, not_connection_owner}, State}; + +handle_call({_, {open, ip_comm, Opts}}, From, State) -> + ?fcrd("handle_call(open)", [{opts, Opts}]), + case key_search(host, Opts, undefined) of + undefined -> + {stop, normal, {error, ehost}, State}; + Host -> + Mode = key_search(mode, Opts, ?DEFAULT_MODE), + Port = key_search(port, Opts, ?FTP_PORT), + Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT), + Progress = key_search(progress, Opts, ignore), + + State2 = State#state{client = From, + mode = Mode, + progress = progress(Progress)}, + + ?fcrd("handle_call(open) -> setup ctrl connection with", + [{host, Host}, {port, Port}, {timeout, Timeout}]), + case setup_ctrl_connection(Host, Port, Timeout, State2) of + {ok, State3, WaitTimeout} -> + ?fcrd("handle_call(open) -> ctrl connection setup done", + [{waittimeout, WaitTimeout}]), + {noreply, State3, WaitTimeout}; + {error, Reason} -> + ?fcrd("handle_call(open) -> ctrl connection setup failed", + [{reason, Reason}]), + gen_server:reply(From, {error, ehost}), + {stop, normal, State2#state{client = undefined}} + end + end; + +handle_call({_, {open, ip_comm, Host, Opts}}, From, State) -> + Mode = key_search(mode, Opts, ?DEFAULT_MODE), + Port = key_search(port, Opts, ?FTP_PORT), + Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT), + Progress = key_search(progress, Opts, ignore), + + State2 = State#state{client = From, + mode = Mode, + progress = progress(Progress)}, + + case setup_ctrl_connection(Host, Port, Timeout, State2) of + {ok, State3, WaitTimeout} -> + {noreply, State3, WaitTimeout}; + {error, _Reason} -> + gen_server:reply(From, {error, ehost}), + {stop, normal, State2#state{client = undefined}} + end; + +handle_call({_, force_active}, _, State) -> + {reply, ok, State#state{mode = active}}; + +handle_call({_, {user, User, Password}}, From, + #state{csock = CSock} = State) when (CSock =/= undefined) -> + handle_user(User, Password, "", State#state{client = From}); + +handle_call({_, {user, User, Password, Acc}}, From, + #state{csock = CSock} = State) when (CSock =/= undefined) -> + handle_user(User, Password, Acc, State#state{client = From}); + +handle_call({_, {account, Acc}}, From, State)-> + handle_user_account(Acc, State#state{client = From}); + +handle_call({_, pwd}, From, #state{chunk = false} = State) -> + send_ctrl_message(State, mk_cmd("PWD", [])), + activate_ctrl_connection(State), + {noreply, State#state{client = From, caller = pwd}}; + +handle_call({_, lpwd}, From, #state{ldir = LDir} = State) -> + {reply, {ok, LDir}, State#state{client = From}}; + +handle_call({_, {cd, Dir}}, From, #state{chunk = false} = State) -> + send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])), + activate_ctrl_connection(State), + {noreply, State#state{client = From, caller = cd}}; + +handle_call({_,{lcd, Dir}}, _From, #state{ldir = LDir0} = State) -> + LDir = filename:absname(Dir, LDir0), + case file:read_file_info(LDir) of %% FIX better check that LDir is a dir. + {ok, _ } -> + {reply, ok, State#state{ldir = LDir}}; + _ -> + {reply, {error, epath}, State} + end; + +handle_call({_, {dir, Len, Dir}}, {_Pid, _} = From, + #state{chunk = false} = State) -> + setup_data_connection(State#state{caller = {dir, Dir, Len}, + client = From}); +handle_call({_, {rename, CurrFile, NewFile}}, From, + #state{chunk = false} = State) -> + send_ctrl_message(State, mk_cmd("RNFR ~s", [CurrFile])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {rename, NewFile}, client = From}}; + +handle_call({_, {delete, File}}, {_Pid, _} = From, + #state{chunk = false} = State) -> + send_ctrl_message(State, mk_cmd("DELE ~s", [File])), + activate_ctrl_connection(State), + {noreply, State#state{client = From}}; + +handle_call({_, {mkdir, Dir}}, From, #state{chunk = false} = State) -> + send_ctrl_message(State, mk_cmd("MKD ~s", [Dir])), + activate_ctrl_connection(State), + {noreply, State#state{client = From}}; + +handle_call({_,{rmdir, Dir}}, From, #state{chunk = false} = State) -> + send_ctrl_message(State, mk_cmd("RMD ~s", [Dir])), + activate_ctrl_connection(State), + {noreply, State#state{client = From}}; + +handle_call({_,{type, Type}}, From, #state{chunk = false} + = State) -> + case Type of + ascii -> + send_ctrl_message(State, mk_cmd("TYPE A", [])), + activate_ctrl_connection(State), + {noreply, State#state{caller = type, type = ascii, + client = From}}; + binary -> + send_ctrl_message(State, mk_cmd("TYPE I", [])), + activate_ctrl_connection(State), + {noreply, State#state{caller = type, type = binary, + client = From}}; + _ -> + {reply, {error, etype}, State} + end; + +handle_call({_,{recv, RemoteFile, LocalFile}}, From, + #state{chunk = false, ldir = LocalDir} = State) -> + progress_report({remote_file, RemoteFile}, State), + NewLocalFile = filename:absname(LocalFile, LocalDir), + + case file_open(NewLocalFile, write) of + {ok, Fd} -> + setup_data_connection(State#state{client = From, + caller = + {recv_file, + RemoteFile, Fd}}); + {error, _What} -> + {reply, {error, epath}, State} + end; + +handle_call({_, {recv_bin, RemoteFile}}, From, #state{chunk = false} = + State) -> + setup_data_connection(State#state{caller = {recv_bin, RemoteFile}, + client = From}); + +handle_call({_,{recv_chunk_start, RemoteFile}}, From, #state{chunk = false} + = State) -> + setup_data_connection(State#state{caller = {start_chunk_transfer, + "RETR", RemoteFile}, + client = From}); + +handle_call({_, recv_chunk}, _, #state{chunk = false} = State) -> + {reply, {error, "ftp:recv_chunk_start/2 not called"}, State}; + +handle_call({_, recv_chunk}, From, #state{chunk = true} = State) -> + activate_data_connection(State), + {noreply, State#state{client = From, caller = recv_chunk}}; + +handle_call({_, {send, LocalFile, RemoteFile}}, From, + #state{chunk = false, ldir = LocalDir} = State) -> + progress_report({local_file, filename:absname(LocalFile, LocalDir)}, + State), + setup_data_connection(State#state{caller = {transfer_file, + {"STOR", + LocalFile, RemoteFile}}, + client = From}); +handle_call({_, {append, LocalFile, RemoteFile}}, From, + #state{chunk = false} = State) -> + setup_data_connection(State#state{caller = {transfer_file, + {"APPE", + LocalFile, RemoteFile}}, + client = From}); +handle_call({_, {send_bin, Bin, RemoteFile}}, From, + #state{chunk = false} = State) -> + setup_data_connection(State#state{caller = {transfer_data, + {"STOR", Bin, RemoteFile}}, + client = From}); +handle_call({_,{append_bin, Bin, RemoteFile}}, From, + #state{chunk = false} = State) -> + setup_data_connection(State#state{caller = {transfer_data, + {"APPE", Bin, RemoteFile}}, + client = From}); +handle_call({_, {send_chunk_start, RemoteFile}}, From, #state{chunk = false} + = State) -> + setup_data_connection(State#state{caller = {start_chunk_transfer, + "STOR", RemoteFile}, + client = From}); +handle_call({_, {append_chunk_start, RemoteFile}}, From, #state{chunk = false} + = State) -> + setup_data_connection(State#state{caller = {start_chunk_transfer, + "APPE", RemoteFile}, + client = From}); +handle_call({_, {transfer_chunk, Bin}}, _, #state{chunk = true} = State) -> + send_data_message(State, Bin), + {reply, ok, State}; + +handle_call({_, chunk_end}, From, #state{chunk = true} = State) -> + close_data_connection(State), + activate_ctrl_connection(State), + {noreply, State#state{client = From, dsock = undefined, + caller = end_chunk_transfer, chunk = false}}; + +handle_call({_, {quote, Cmd}}, From, #state{chunk = false} = State) -> + send_ctrl_message(State, mk_cmd(Cmd, [])), + activate_ctrl_connection(State), + {noreply, State#state{client = From, caller = quote}}; + +handle_call({_, _Req}, _From, #state{csock = CSock} = State) + when (CSock =:= undefined) -> + {reply, {error, not_connected}, State}; + +handle_call(_, _, #state{chunk = true} = State) -> + {reply, {error, echunk}, State}; + +%% Catch all - This can only happen if the application programmer writes +%% really bad code that violates the API. +handle_call(Request, _Timeout, State) -> + {stop, {'API_violation_connection_closed', Request}, + {error, {connection_terminated, 'API_violation'}}, State}. + +%%-------------------------------------------------------------------------- +%% handle_cast(Request, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} +%% Description: Handles cast messages. +%%------------------------------------------------------------------------- +handle_cast({Pid, close}, #state{owner = Pid} = State) -> + send_ctrl_message(State, mk_cmd("QUIT", [])), + close_ctrl_connection(State), + close_data_connection(State), + {stop, normal, State#state{csock = undefined, dsock = undefined}}; + +handle_cast({Pid, close}, State) -> + Report = io_lib:format("A none owner process ~p tried to close an " + "ftp connection: ~n", [Pid]), + error_logger:info_report(Report), + {noreply, State}; + +%% Catch all - This can oly happen if the application programmer writes +%% really bad code that violates the API. +handle_cast(Msg, State) -> + {stop, {'API_violation_connection_closed', Msg}, State}. + +%%-------------------------------------------------------------------------- +%% handle_info(Msg, State) -> {noreply, State} | {noreply, State, Timeout} | +%% {stop, Reason, State} +%% Description: Handles tcp messages from the ftp-server. +%% Note: The order of the function clauses is significant. +%%-------------------------------------------------------------------------- + +handle_info(timeout, #state{caller = open} = State) -> + {stop, timeout, State}; + +handle_info(timeout, State) -> + {noreply, State}; + +%%% Data socket messages %%% +handle_info({tcp, Socket, Data}, + #state{dsock = Socket, + caller = {recv_file, Fd}} = State) -> + file_write(binary_to_list(Data), Fd), + progress_report({binary, Data}, State), + activate_data_connection(State), + {noreply, State}; + +handle_info({tcp, Socket, Data}, #state{dsock = Socket, client = From, + caller = recv_chunk} + = State) -> + gen_server:reply(From, {ok, Data}), + {noreply, State#state{client = undefined, data = <<>>}}; + +handle_info({tcp, Socket, Data}, #state{dsock = Socket} = State) -> + activate_data_connection(State), + {noreply, State#state{data = <<(State#state.data)/binary, + Data/binary>>}}; + +handle_info({tcp_closed, Socket}, #state{dsock = Socket, + caller = {recv_file, Fd}} + = State) -> + file_close(Fd), + progress_report({transfer_size, 0}, State), + activate_ctrl_connection(State), + {noreply, State#state{dsock = undefined, data = <<>>}}; + +handle_info({tcp_closed, Socket}, #state{dsock = Socket, client = From, + caller = recv_chunk} + = State) -> + gen_server:reply(From, ok), + {noreply, State#state{dsock = undefined, client = undefined, + data = <<>>, caller = undefined, + chunk = false}}; + +handle_info({tcp_closed, Socket}, #state{dsock = Socket, caller = recv_bin, + data = Data} = State) -> + activate_ctrl_connection(State), + {noreply, State#state{dsock = undefined, data = <<>>, + caller = {recv_bin, Data}}}; + +handle_info({tcp_closed, Socket}, #state{dsock = Socket, data = Data, + caller = {handle_dir_result, Dir}} + = State) -> + activate_ctrl_connection(State), + {noreply, State#state{dsock = undefined, + caller = {handle_dir_result, Dir, Data}, +% data = <<?CR,?LF>>}}; + data = <<>>}}; + +handle_info({tcp_error, Socket, Reason}, #state{dsock = Socket, + client = From} = State) -> + gen_server:reply(From, {error, Reason}), + close_data_connection(State), + {noreply, State#state{dsock = undefined, client = undefined, + data = <<>>, caller = undefined, chunk = false}}; + +%%% Ctrl socket messages %%% +handle_info({tcp, Socket, Data}, #state{csock = Socket, + verbose = Verbose, + caller = Caller, + client = From, + ctrl_data = {CtrlData, AccLines, + LineStatus}} + = State) -> + case ftp_response:parse_lines(<<CtrlData/binary, Data/binary>>, + AccLines, LineStatus) of + {ok, Lines, NextMsgData} -> + verbose(Lines, Verbose, 'receive'), + CtrlResult = ftp_response:interpret(Lines), + case Caller of + quote -> + gen_server:reply(From, string:tokens(Lines, [?CR, ?LF])), + {noreply, State#state{client = undefined, + caller = undefined, + ctrl_data = {NextMsgData, [], + start}}}; + _ -> + handle_ctrl_result(CtrlResult, + State#state{ctrl_data = + {NextMsgData, [], start}}) + end; + {continue, NewCtrlData} -> + activate_ctrl_connection(State), + {noreply, State#state{ctrl_data = NewCtrlData}} + end; + +handle_info({tcp_closed, Socket}, #state{csock = Socket}) -> + %% If the server closes the control channel it is + %% the expected behavior that connection process terminates. + exit(normal); %% User will get error message from terminate/2 + +handle_info({tcp_error, Socket, Reason}, _) -> + Report = + io_lib:format("tcp_error on socket: ~p for reason: ~p~n", + [Socket, Reason]), + error_logger:error_report(Report), + %% If tcp does not work the only option is to terminate, + %% this is the expected behavior under these circumstances. + exit(normal); %% User will get error message from terminate/2 + +%% Monitor messages - if the process owning the ftp connection goes +%% down there is no point in continuing. +handle_info({'DOWN', _Ref, _Type, _Process, normal}, State) -> + {stop, normal, State#state{client = undefined}}; + +handle_info({'DOWN', _Ref, _Type, _Process, shutdown}, State) -> + {stop, normal, State#state{client = undefined}}; + +handle_info({'DOWN', _Ref, _Type, _Process, timeout}, State) -> + {stop, normal, State#state{client = undefined}}; + +handle_info({'DOWN', _Ref, _Type, Process, Reason}, State) -> + {stop, {stopped, {'EXIT', Process, Reason}}, + State#state{client = undefined}}; + +handle_info({'EXIT', Pid, Reason}, #state{progress = Pid} = State) -> + Report = io_lib:format("Progress reporting stopped for reason ~p~n", + Reason), + error_logger:info_report(Report), + {noreply, State#state{progress = ignore}}; + +%% Catch all - throws away unknown messages (This could happen by "accident" +%% so we do not want to crash, but we make a log entry as it is an +%% unwanted behaviour.) +handle_info(Info, State) -> + Report = io_lib:format("ftp : ~p : Unexpected message: ~p\n", + [self(), Info]), + error_logger:info_report(Report), + {noreply, State}. + +%%-------------------------------------------------------------------------- +%% terminate/2 and code_change/3 +%%-------------------------------------------------------------------------- +terminate(normal, State) -> + %% If terminate reason =/= normal the progress reporting process will + %% be killed by the exit signal. + progress_report(stop, State), + do_termiante({error, econn}, State); +terminate(Reason, State) -> + Report = io_lib:format("Ftp connection closed due to: ~p~n", [Reason]), + error_logger:error_report(Report), + do_termiante({error, eclosed}, State). + +do_termiante(ErrorMsg, State) -> + close_data_connection(State), + close_ctrl_connection(State), + case State#state.client of + undefined -> + ok; + From -> + gen_server:reply(From, ErrorMsg) + end, + ok. + +code_change(_Vsn, State1, upgrade_from_pre_5_12) -> + {state, CSock, DSock, Verbose, LDir, Type, Chunk, Mode, Timeout, + Data, CtrlData, Owner, Client, Caller, IPv6Disable, Progress} = State1, + IpFamily = + if + (IPv6Disable =:= true) -> + inet; + true -> + inet6fb4 + end, + State2 = #state{csock = CSock, + dsock = DSock, + verbose = Verbose, + ldir = LDir, + type = Type, + chunk = Chunk, + mode = Mode, + timeout = Timeout, + data = Data, + ctrl_data = CtrlData, + owner = Owner, + client = Client, + caller = Caller, + ipfamily = IpFamily, + progress = Progress}, + {ok, State2}; + +code_change(_Vsn, State1, downgrade_to_pre_5_12) -> + #state{csock = CSock, + dsock = DSock, + verbose = Verbose, + ldir = LDir, + type = Type, + chunk = Chunk, + mode = Mode, + timeout = Timeout, + data = Data, + ctrl_data = CtrlData, + owner = Owner, + client = Client, + caller = Caller, + ipfamily = IpFamily, + progress = Progress} = State1, + IPv6Disable = + if + (IpFamily =:= inet) -> + true; + true -> + false + end, + State2 = + {state, CSock, DSock, Verbose, LDir, Type, Chunk, Mode, Timeout, + Data, CtrlData, Owner, Client, Caller, IPv6Disable, Progress}, + {ok, State2}; + +code_change(_Vsn, State, _Extra) -> + {ok, State}. + + +%%%========================================================================= +%% Start/stop +%%%========================================================================= +%%-------------------------------------------------------------------------- +%% start_link([Opts, GenServerOptions]) -> {ok, Pid} | {error, Reason} +%% +%% Description: Callback function for the ftp supervisor. It is called +%% : when start_service/1 calls ftp_sup:start_child/1 to start an +%% : instance of the ftp process. Also called by start_standalone/1 +%%-------------------------------------------------------------------------- +start_link([Opts, GenServerOptions]) -> + start_link(Opts, GenServerOptions). + +start_link(Opts, GenServerOptions) -> + case lists:keysearch(client, 1, Opts) of + {value, _} -> + %% Via the supervisor + gen_server:start_link(?MODULE, Opts, GenServerOptions); + false -> + Opts2 = [{client, self()} | Opts], + gen_server:start_link(?MODULE, Opts2, GenServerOptions) + end. + + +%%% Stop functionality is handled by close/1 + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%%-------------------------------------------------------------------------- +%%% Help functions to handle_call and/or handle_ctrl_result +%%-------------------------------------------------------------------------- +%% User handling +handle_user(User, Password, Acc, State) -> + send_ctrl_message(State, mk_cmd("USER ~s", [User])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {handle_user, Password, Acc}}}. + +handle_user_passwd(Password, Acc, State) -> + send_ctrl_message(State, mk_cmd("PASS ~s", [Password])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {handle_user_passwd, Acc}}}. + +handle_user_account(Acc, State) -> + send_ctrl_message(State, mk_cmd("ACCT ~s", [Acc])), + activate_ctrl_connection(State), + {noreply, State#state{caller = handle_user_account}}. + + +%%-------------------------------------------------------------------------- +%% handle_ctrl_result +%%-------------------------------------------------------------------------- +%%-------------------------------------------------------------------------- +%% Handling of control connection setup +handle_ctrl_result({pos_compl, _}, #state{caller = open, client = From} + = State) -> + gen_server:reply(From, {ok, self()}), + {noreply, State#state{client = undefined, + caller = undefined }}; +handle_ctrl_result({_, Lines}, #state{caller = open} = State) -> + ctrl_result_response(econn, State, {error, Lines}); + +%%-------------------------------------------------------------------------- +%% Data connection setup active mode +handle_ctrl_result({pos_compl, _Lines}, + #state{mode = active, + caller = {setup_data_connection, + {LSock, Caller}}} = State) -> + handle_caller(State#state{caller = Caller, dsock = {lsock, LSock}}); + +handle_ctrl_result({Status, Lines}, + #state{mode = active, + caller = {setup_data_connection, {LSock, _}}} + = State) -> + close_connection(LSock), + ctrl_result_response(Status, State, {error, Lines}); + +%% Data connection setup passive mode +handle_ctrl_result({pos_compl, Lines}, + #state{mode = passive, + ipfamily = inet6, + client = From, + caller = {setup_data_connection, Caller}, + csock = CSock, + timeout = Timeout} + = State) -> + [_, PortStr | _] = lists:reverse(string:tokens(Lines, "|")), + {ok, {IP, _}} = inet:peername(CSock), + case connect(IP, list_to_integer(PortStr), Timeout, State) of + {ok, _, Socket} -> + handle_caller(State#state{caller = Caller, dsock = Socket}); + {error, _Reason} = Error -> + gen_server:reply(From, Error), + {noreply, State#state{client = undefined, caller = undefined}} + end; + +handle_ctrl_result({pos_compl, Lines}, + #state{mode = passive, + ipfamily = inet, + client = From, + caller = {setup_data_connection, Caller}, + timeout = Timeout} = State) -> + + {_, [?LEFT_PAREN | Rest]} = + lists:splitwith(fun(?LEFT_PAREN) -> false; (_) -> true end, Lines), + {NewPortAddr, _} = + lists:splitwith(fun(?RIGHT_PAREN) -> false; (_) -> true end, Rest), + [A1, A2, A3, A4, P1, P2] = + lists:map(fun(X) -> list_to_integer(X) end, + string:tokens(NewPortAddr, [$,])), + IP = {A1, A2, A3, A4}, + Port = (P1 * 256) + P2, + case connect(IP, Port, Timeout, State) of + {ok, _, Socket} -> + handle_caller(State#state{caller = Caller, dsock = Socket}); + {error, _Reason} = Error -> + gen_server:reply(From, Error), + {noreply,State#state{client = undefined, caller = undefined}} + end; + +%% FTP server does not support passive mode: try to fallback on active mode +handle_ctrl_result(_, + #state{mode = passive, + caller = {setup_data_connection, Caller}} = State) -> + setup_data_connection(State#state{mode = active, caller = Caller}); + + +%%-------------------------------------------------------------------------- +%% User handling +handle_ctrl_result({pos_interm, _}, + #state{caller = {handle_user, PassWord, Acc}} = State) -> + handle_user_passwd(PassWord, Acc, State); +handle_ctrl_result({Status, _}, + #state{caller = {handle_user, _, _}} = State) -> + ctrl_result_response(Status, State, {error, euser}); + +%% Accounts +handle_ctrl_result({pos_interm_acct, _}, + #state{caller = {handle_user_passwd, Acc}} = State) + when Acc =/= "" -> + handle_user_account(Acc, State); +handle_ctrl_result({Status, _}, + #state{caller = {handle_user_passwd, _}} = State) -> + ctrl_result_response(Status, State, {error, euser}); + +%%-------------------------------------------------------------------------- +%% Print current working directory +handle_ctrl_result({pos_compl, Lines}, + #state{caller = pwd, client = From} = State) -> + Dir = pwd_result(Lines), + gen_server:reply(From, {ok, Dir}), + {noreply, State#state{client = undefined, caller = undefined}}; + +%%-------------------------------------------------------------------------- +%% Directory listing +handle_ctrl_result({pos_prel, _}, #state{caller = {dir, Dir}} = State) -> + NewState = accept_data_connection(State), + activate_data_connection(NewState), + {noreply, NewState#state{caller = {handle_dir_result, Dir}}}; + +handle_ctrl_result({pos_compl, _}, #state{caller = {handle_dir_result, Dir, + Data}, client = From} + = State) -> + case Dir of + "" -> % Current directory + gen_server:reply(From, {ok, Data}), + {noreply, State#state{client = undefined, + caller = undefined}}; + _ -> + %% <WTF> + %% Dir cannot be assumed to be a dir. It is a string that + %% could be a dir, but could also be a file or even a string + %% containing wildcards (*). + %% + %% %% If there is only one line it might be a directory with one + %% %% file but it might be an error message that the directory + %% %% was not found. So in this case we have to endure a little + %% %% overhead to be able to give a good return value. Alas not + %% %% all ftp implementations behave the same and returning + %% %% an error string is allowed by the FTP RFC. + %% case lists:dropwhile(fun(?CR) -> false;(_) -> true end, + %% binary_to_list(Data)) of + %% L when (L =:= [?CR, ?LF]) orelse (L =:= []) -> + %% send_ctrl_message(State, mk_cmd("PWD", [])), + %% activate_ctrl_connection(State), + %% {noreply, + %% State#state{caller = {handle_dir_data, Dir, Data}}}; + %% _ -> + %% gen_server:reply(From, {ok, Data}), + %% {noreply, State#state{client = undefined, + %% caller = undefined}} + %% end + %% </WTF> + gen_server:reply(From, {ok, Data}), + {noreply, State#state{client = undefined, + caller = undefined}} + end; + +handle_ctrl_result({pos_compl, Lines}, + #state{caller = {handle_dir_data, Dir, DirData}} = + State) -> + OldDir = pwd_result(Lines), + send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {handle_dir_data_second_phase, OldDir, + DirData}}}; +handle_ctrl_result({Status, _}, + #state{caller = {handle_dir_data, _, _}} = State) -> + ctrl_result_response(Status, State, {error, epath}); + +handle_ctrl_result(S={_Status, _}, + #state{caller = {handle_dir_result, _, _}} = State) -> + %% OTP-5731, macosx + ctrl_result_response(S, State, {error, epath}); + +handle_ctrl_result({pos_compl, _}, + #state{caller = {handle_dir_data_second_phase, OldDir, + DirData}} = State) -> + send_ctrl_message(State, mk_cmd("CWD ~s", [OldDir])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {handle_dir_data_third_phase, DirData}}}; +handle_ctrl_result({Status, _}, + #state{caller = {handle_dir_data_second_phase, _, _}} + = State) -> + ctrl_result_response(Status, State, {error, epath}); +handle_ctrl_result(_, #state{caller = {handle_dir_data_third_phase, DirData}, + client = From} = State) -> + gen_server:reply(From, {ok, DirData}), + {noreply, State#state{client = undefined, caller = undefined}}; + +handle_ctrl_result({Status, _}, #state{caller = cd} = State) -> + ctrl_result_response(Status, State, {error, epath}); + +handle_ctrl_result(Status={epath, _}, #state{caller = {dir,_}} = State) -> + ctrl_result_response(Status, State, {error, epath}); + +%%-------------------------------------------------------------------------- +%% File renaming +handle_ctrl_result({pos_interm, _}, #state{caller = {rename, NewFile}} + = State) -> + send_ctrl_message(State, mk_cmd("RNTO ~s", [NewFile])), + activate_ctrl_connection(State), + {noreply, State#state{caller = rename_second_phase}}; + +handle_ctrl_result({Status, _}, + #state{caller = {rename, _}} = State) -> + ctrl_result_response(Status, State, {error, epath}); + +handle_ctrl_result({Status, _}, + #state{caller = rename_second_phase} = State) -> + ctrl_result_response(Status, State, {error, epath}); + +%%-------------------------------------------------------------------------- +%% File handling - recv_bin +handle_ctrl_result({pos_prel, _}, #state{caller = recv_bin} = State) -> + NewState = accept_data_connection(State), + activate_data_connection(NewState), + {noreply, NewState}; + +handle_ctrl_result({pos_compl, _}, #state{caller = {recv_bin, Data}, + client = From} = State) -> + gen_server:reply(From, {ok, Data}), + close_data_connection(State), + {noreply, State#state{client = undefined, caller = undefined}}; + +handle_ctrl_result({Status, _}, #state{caller = recv_bin} = State) -> + close_data_connection(State), + ctrl_result_response(Status, State#state{dsock = undefined}, + {error, epath}); + +handle_ctrl_result({Status, _}, #state{caller = {recv_bin, _}} = State) -> + close_data_connection(State), + ctrl_result_response(Status, State#state{dsock = undefined}, + {error, epath}); +%%-------------------------------------------------------------------------- +%% File handling - start_chunk_transfer +handle_ctrl_result({pos_prel, _}, #state{client = From, + caller = start_chunk_transfer} + = State) -> + NewState = accept_data_connection(State), + gen_server:reply(From, ok), + {noreply, NewState#state{chunk = true, client = undefined, + caller = undefined}}; +%%-------------------------------------------------------------------------- +%% File handling - recv_file +handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State) -> + NewState = accept_data_connection(State), + activate_data_connection(NewState), + {noreply, NewState}; + +handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) -> + file_close(Fd), + close_data_connection(State), + ctrl_result_response(Status, State#state{dsock = undefined}, + {error, epath}); +%%-------------------------------------------------------------------------- +%% File handling - transfer_* +handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_file, Fd}} + = State) -> + NewState = accept_data_connection(State), + send_file(Fd, NewState); + +handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_data, Bin}} + = State) -> + NewState = accept_data_connection(State), + send_data_message(NewState, Bin), + close_data_connection(NewState), + activate_ctrl_connection(NewState), + {noreply, NewState#state{caller = transfer_data_second_phase, + dsock = undefined}}; +%%-------------------------------------------------------------------------- +%% Default +handle_ctrl_result({Status, Lines}, #state{client = From} = State) + when From =/= undefined -> + ctrl_result_response(Status, State, {error, Lines}). + +%%-------------------------------------------------------------------------- +%% Help functions to handle_ctrl_result +%%-------------------------------------------------------------------------- +ctrl_result_response(pos_compl, #state{client = From} = State, _) -> + gen_server:reply(From, ok), + {noreply, State#state{client = undefined, caller = undefined}}; + +ctrl_result_response(Status, #state{client = From} = State, _) + when (Status =:= etnospc) orelse + (Status =:= epnospc) orelse + (Status =:= efnamena) orelse + (Status =:= econn) -> +%Status == etnospc; Status == epnospc; Status == econn -> + gen_server:reply(From, {error, Status}), +%% {stop, normal, {error, Status}, State#state{client = undefined}}; + {stop, normal, State#state{client = undefined}}; + +ctrl_result_response(_, #state{client = From} = State, ErrorMsg) -> + gen_server:reply(From, ErrorMsg), + {noreply, State#state{client = undefined, caller = undefined}}. + +%%-------------------------------------------------------------------------- +handle_caller(#state{caller = {dir, Dir, Len}} = State) -> + Cmd = case Len of + short -> "NLST"; + long -> "LIST" + end, + case Dir of + "" -> + send_ctrl_message(State, mk_cmd(Cmd, "")); + _ -> + send_ctrl_message(State, mk_cmd(Cmd ++ " ~s", [Dir])) + end, + activate_ctrl_connection(State), + {noreply, State#state{caller = {dir, Dir}}}; + +handle_caller(#state{caller = {recv_bin, RemoteFile}} = State) -> + send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])), + activate_ctrl_connection(State), + {noreply, State#state{caller = recv_bin}}; + +handle_caller(#state{caller = {start_chunk_transfer, Cmd, RemoteFile}} = + State) -> + send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])), + activate_ctrl_connection(State), + {noreply, State#state{caller = start_chunk_transfer}}; + +handle_caller(#state{caller = {recv_file, RemoteFile, Fd}} = State) -> + send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {recv_file, Fd}}}; + +handle_caller(#state{caller = {transfer_file, {Cmd, LocalFile, RemoteFile}}, + ldir = LocalDir, client = From} = State) -> + case file_open(filename:absname(LocalFile, LocalDir), read) of + {ok, Fd} -> + send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {transfer_file, Fd}}}; + {error, _} -> + gen_server:reply(From, {error, epath}), + {noreply, State#state{client = undefined, caller = undefined, + dsock = undefined}} + end; + +handle_caller(#state{caller = {transfer_data, {Cmd, Bin, RemoteFile}}} = + State) -> + send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {transfer_data, Bin}}}. + +%% ----------- FTP SERVER COMMUNICATION ------------------------- + +%% Connect to FTP server at Host (default is TCP port 21) +%% in order to establish a control connection. +setup_ctrl_connection(Host, Port, Timeout, State) -> + MsTime = millisec_time(), + case connect(Host, Port, Timeout, State) of + {ok, IpFam, CSock} -> + NewState = State#state{csock = CSock, ipfamily = IpFam}, + activate_ctrl_connection(NewState), + case Timeout - (millisec_time() - MsTime) of + Timeout2 when (Timeout2 >= 0) -> + {ok, NewState#state{caller = open}, Timeout2}; + _ -> + %% Oups: Simulate timeout + {ok, NewState#state{caller = open}, 0} + end; + Error -> + Error + end. + +setup_data_connection(#state{mode = active, + caller = Caller, + csock = CSock} = State) -> + IntToString = fun(Element) -> integer_to_list(Element) end, + + case (catch inet:sockname(CSock)) of + {ok, {{_, _, _, _, _, _, _, _} = IP, _}} -> + {ok, LSock} = + gen_tcp:listen(0, [{ip, IP}, {active, false}, + inet6, binary, {packet, 0}]), + {ok, Port} = inet:port(LSock), + Cmd = mk_cmd("EPRT |2|~s:~s:~s:~s:~s:~s:~s:~s|~s|", + lists:map(IntToString, + tuple_to_list(IP) ++ [Port])), + send_ctrl_message(State, Cmd), + activate_ctrl_connection(State), + {noreply, State#state{caller = {setup_data_connection, + {LSock, Caller}}}}; + {ok, {{_,_,_,_} = IP, _}} -> + {ok, LSock} = gen_tcp:listen(0, [{ip, IP}, {active, false}, + binary, {packet, 0}]), + {ok, Port} = inet:port(LSock), + {IP1, IP2, IP3, IP4} = IP, + {Port1, Port2} = {Port div 256, Port rem 256}, + send_ctrl_message(State, + mk_cmd("PORT ~w,~w,~w,~w,~w,~w", + [IP1, IP2, IP3, IP4, Port1, Port2])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {setup_data_connection, + {LSock, Caller}}}} + end; + +setup_data_connection(#state{mode = passive, ipfamily = inet6, + caller = Caller} = State) -> + send_ctrl_message(State, mk_cmd("EPSV", [])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {setup_data_connection, Caller}}}; + +setup_data_connection(#state{mode = passive, ipfamily = inet, + caller = Caller} = State) -> + send_ctrl_message(State, mk_cmd("PASV", [])), + activate_ctrl_connection(State), + {noreply, State#state{caller = {setup_data_connection, Caller}}}. + + +%% setup_data_connection(#state{mode = passive, ip_v6_disabled = false, +%% caller = Caller} = State) -> +%% send_ctrl_message(State, mk_cmd("EPSV", [])), +%% activate_ctrl_connection(State), +%% {noreply, State#state{caller = {setup_data_connection, Caller}}}; + +%% setup_data_connection(#state{mode = passive, ip_v6_disabled = true, +%% caller = Caller} = State) -> +%% send_ctrl_message(State, mk_cmd("PASV", [])), +%% activate_ctrl_connection(State), +%% {noreply, State#state{caller = {setup_data_connection, Caller}}}. + + +connect(Host, Port, Timeout, #state{ipfamily = inet = IpFam}) -> + connect2(Host, Port, IpFam, Timeout); + +connect(Host, Port, Timeout, #state{ipfamily = inet6 = IpFam}) -> + connect2(Host, Port, IpFam, Timeout); + +connect(Host, Port, Timeout, #state{ipfamily = inet6fb4}) -> + case inet:getaddr(Host, inet6) of + {ok, {0, 0, 0, 0, 0, 16#ffff, _, _} = IPv6} -> + case inet:getaddr(Host, inet) of + {ok, IPv4} -> + IpFam = inet, + connect2(IPv4, Port, IpFam, Timeout); + + _ -> + IpFam = inet6, + connect2(IPv6, Port, IpFam, Timeout) + end; + + {ok, IPv6} -> + IpFam = inet6, + connect2(IPv6, Port, IpFam, Timeout); + + _ -> + case inet:getaddr(Host, inet) of + {ok, IPv4} -> + IpFam = inet, + connect2(IPv4, Port, IpFam, Timeout); + Error -> + Error + end + end. + +connect2(Host, Port, IpFam, Timeout) -> + Opts = [IpFam, binary, {packet, 0}, {active, false}], + case gen_tcp:connect(Host, Port, Opts, Timeout) of + {ok, Sock} -> + {ok, IpFam, Sock}; + Error -> + Error + end. + + + +accept_data_connection(#state{mode = active, + dsock = {lsock, LSock}} = State) -> + {ok, Socket} = gen_tcp:accept(LSock), + gen_tcp:close(LSock), + State#state{dsock = Socket}; + +accept_data_connection(#state{mode = passive} = State) -> + State. + +send_ctrl_message(#state{csock = Socket, verbose = Verbose}, Message) -> + %% io:format("send control message: ~n~p~n", [lists:flatten(Message)]), + verbose(lists:flatten(Message),Verbose,send), + send_message(Socket, Message). + +send_data_message(#state{dsock = Socket}, Message) -> + send_message(Socket, Message). + +send_message(Socket, Message) -> + case gen_tcp:send(Socket, Message) of + ok -> + ok; + {error, Reason} -> + Report = io_lib:format("gen_tcp:send/2 failed for " + "reason ~p~n", [Reason]), + error_logger:error_report(Report), + %% If tcp does not work the only option is to terminate, + %% this is the expected behavior under these circumstances. + exit(normal) %% User will get error message from terminate/2 + end. + +activate_ctrl_connection(#state{csock = Socket, ctrl_data = {<<>>, _, _}}) -> + activate_connection(Socket); +activate_ctrl_connection(#state{csock = Socket}) -> + %% We have already received at least part of the next control message, + %% that has been saved in ctrl_data, process this first. + self() ! {tcp, Socket, <<>>}. + +activate_data_connection(#state{dsock = Socket}) -> + activate_connection(Socket). + +activate_connection(Socket) -> + inet:setopts(Socket, [{active, once}]). + +close_ctrl_connection(#state{csock = undefined}) -> + ok; +close_ctrl_connection(#state{csock = Socket}) -> + close_connection(Socket). + +close_data_connection(#state{dsock = undefined}) -> + ok; +close_data_connection(#state{dsock = {lsock, Socket}}) -> + close_connection(Socket); +close_data_connection(#state{dsock = Socket}) -> + close_connection(Socket). + +close_connection(Socket) -> + gen_tcp:close(Socket). + +%% ------------ FILE HANDELING ---------------------------------------- + +send_file(Fd, State) -> + case file_read(Fd) of + {ok, N, Bin} when N > 0-> + send_data_message(State, Bin), + progress_report({binary, Bin}, State), + send_file(Fd, State); + {ok, _, _} -> + file_close(Fd), + close_data_connection(State), + progress_report({transfer_size, 0}, State), + activate_ctrl_connection(State), + {noreply, State#state{caller = transfer_file_second_phase, + dsock = undefined}}; + {error, Reason} -> + gen_server:reply(State#state.client, {error, Reason}), + {stop, normal, State#state{client = undefined}} + end. + +file_open(File, Option) -> + file:open(File, [raw, binary, Option]). + +file_close(Fd) -> + file:close(Fd). + +file_read(Fd) -> + case file:read(Fd, ?FILE_BUFSIZE) of + {ok, Bytes} -> + {ok, size(Bytes), Bytes}; + eof -> + {ok, 0, []}; + Other -> + Other + end. + +file_write(Bytes, Fd) -> + file:write(Fd, Bytes). + +%% -------------- MISC ---------------------------------------------- + +call(GenServer, Msg, Format) -> + call(GenServer, Msg, Format, infinity). +call(GenServer, Msg, Format, Timeout) -> + Req = {self(), Msg}, + case (catch gen_server:call(GenServer, Req, Timeout)) of + {ok, Bin} when is_binary(Bin) andalso (Format =:= string) -> + {ok, binary_to_list(Bin)}; + {'EXIT', _} -> + {error, eclosed}; + Result -> + Result + end. + +cast(GenServer, Msg) -> + gen_server:cast(GenServer, {self(), Msg}). + +mk_cmd(Fmt, Args) -> + [io_lib:format(Fmt, Args)| [?CR, ?LF]]. % Deep list ok. + +pwd_result(Lines) -> + {_, [?DOUBLE_QUOTE | Rest]} = + lists:splitwith(fun(?DOUBLE_QUOTE) -> false; (_) -> true end, Lines), + {Dir, _} = + lists:splitwith(fun(?DOUBLE_QUOTE) -> false; (_) -> true end, Rest), + Dir. + +%% is_verbose(Params) -> +%% check_param(verbose, Params). + +%% is_debug(Flags) -> +%% check_param(debug, Flags). + +%% is_trace(Flags) -> +%% check_param(trace, Flags). + +%% is_ipv6_disabled(Flags) -> +%% check_param(ip_v6_disabled, Flags). + +%% check_param(Param, Params) -> +%% lists:member(Param, Params). + +key_search(Key, List, Default) -> + case lists:keysearch(Key, 1, List) of + {value, {_,Val}} -> + Val; + false -> + Default + end. + +%% check_option(Pred, Value, Default) -> +%% case Pred(Value) of +%% true -> +%% Value; +%% false -> +%% Default +%% end. + +verbose(Lines, true, Direction) -> + DirStr = + case Direction of + send -> + "Sending: "; + _ -> + "Receiving: " + end, + Str = string:strip(string:strip(Lines, right, ?LF), right, ?CR), + erlang:display(DirStr++Str); +verbose(_, false,_) -> + ok. + +progress(Options) -> + ftp_progress:start_link(Options). + +progress_report(_, #state{progress = ignore}) -> + ok; +progress_report(stop, #state{progress = ProgressPid}) -> + ftp_progress:stop(ProgressPid); +progress_report({binary, Data}, #state{progress = ProgressPid}) -> + ftp_progress:report(ProgressPid, {transfer_size, size(Data)}); +progress_report(Report, #state{progress = ProgressPid}) -> + ftp_progress:report(ProgressPid, Report). + + +millisec_time() -> + {A,B,C} = erlang:now(), + A*1000000000+B*1000+(C div 1000). diff --git a/lib/inets/src/ftp/ftp_internal.hrl b/lib/inets/src/ftp/ftp_internal.hrl new file mode 100644 index 0000000000..c3fa1e611d --- /dev/null +++ b/lib/inets/src/ftp/ftp_internal.hrl @@ -0,0 +1,31 @@ +%% +%% %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% +%% +%% + +-ifndef(ftp_internal_hrl). +-define(ftp_internal_hrl, true). + +-include("inets_internal.hrl"). +-define(SERVICE, ftpc). +-define(fcri(Label, Content), ?report_important(Label, ?SERVICE, Content)). +-define(fcrv(Label, Content), ?report_verbose(Label, ?SERVICE, Content)). +-define(fcrd(Label, Content), ?report_debug(Label, ?SERVICE, Content)). +-define(fcrt(Label, Content), ?report_trace(Label, ?SERVICE, Content)). + +-endif. % -ifdef(ftp_internal_hrl). diff --git a/lib/inets/src/ftp/ftp_progress.erl b/lib/inets/src/ftp/ftp_progress.erl new file mode 100644 index 0000000000..39f4d05bc2 --- /dev/null +++ b/lib/inets/src/ftp/ftp_progress.erl @@ -0,0 +1,127 @@ +%% +%% %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% +%% +%% +%% Description: This module impements a temporary process that +%% performes progress reporting during file transfer calling a user +%% defined callback function. Its life span is as long as the ftp connection +%% processes that spawned it lives. The purpose of this process is to +%% shild the ftp connection process from errors and time consuming operations +%% in the user defined callback function. + +-module(ftp_progress). + +%% Internal API +-export([start_link/1, report/2, stop/1]). + +%% Spawn export +-export([init/1]). + +-include_lib("kernel/include/file.hrl"). + +-record(progress, { + file, % string() + cb_module, % atom() + cb_function, % atom() + init_progress_term, % term() + current_progress_term % term() + }). + +%%%========================================================================= +%%% Internal application API +%%%========================================================================= +%%-------------------------------------------------------------------------- +%% start_link(Options) -> ignore | pid() +%% Options = ignore | {CBModule, CBFunction, InitProgressTerm} +%% +%% Description: Starts the progress report process unless progress reporting +%% should not be performed. +%%-------------------------------------------------------------------------- +start_link(ignore) -> + ignore; +start_link(Options) -> + spawn_link(?MODULE, init, [Options]). + +%%-------------------------------------------------------------------------- +%% report_progress(Pid, Report) -> _ +%% Pid = pid() +%% Report = {local_file, File} | {remote_file, File} | +%% {transfer_size, Size} +%% Size = integer() +%% +%% Description: Reports progress to the reporting process that calls the +%% user defined callback function. +%%-------------------------------------------------------------------------- +report(Pid, Report) -> + Pid ! {progress_report, Report}. + +%%-------------------------------------------------------------------------- +%% stop(Pid) -> _ +%% Pid = pid() +%% +%% Description: +%%-------------------------------------------------------------------------- +stop(Pid) -> + Pid ! stop. + +%%%========================================================================= +%%% Internal functions +%%%========================================================================= +init(Options) -> + loop(progress(Options)). + +loop(Progress) -> + receive + {progress_report, Report} -> + NewProgress = report_progress(Report, Progress), + loop(NewProgress); + stop -> + ok + end. + +progress({CBModule, CBFunction, InitProgressTerm}) when is_atom(CBModule), + is_atom(CBFunction) -> + #progress{cb_module = CBModule, + cb_function = CBFunction, + init_progress_term = InitProgressTerm, + current_progress_term = InitProgressTerm}. + +report_progress({local_file, File}, Progress) -> + {ok, FileInfo} = file:read_file_info(File), + report_progress({file_size, FileInfo#file_info.size}, + Progress#progress{file = File}); + +report_progress({remote_file, File}, Progress) -> + report_progress({file_size, unknown}, Progress#progress{file = File}); + +report_progress(Size, #progress{file = File, + cb_module = CBModule, + cb_function = CBFunction, + current_progress_term = Term, + init_progress_term = InitTerm} = Progress) -> + + NewProgressTerm = CBModule:CBFunction(Term, File, Size), + + case Size of + {transfer_size, 0} -> + %% Transfer is compleat reset initial values + Progress#progress{current_progress_term = InitTerm, + file = undefined}; + _ -> + Progress#progress{current_progress_term = NewProgressTerm} + end. diff --git a/lib/inets/src/ftp/ftp_response.erl b/lib/inets/src/ftp/ftp_response.erl new file mode 100644 index 0000000000..faeacb31ab --- /dev/null +++ b/lib/inets/src/ftp/ftp_response.erl @@ -0,0 +1,192 @@ +%% +%% %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% +%% +%% +%% Description: This module impements handling of ftp server responses. + +-module(ftp_response). + +%% Internal API +-export([parse_lines/3, interpret/1, error_string/1]). + +-include("ftp_internal.hrl"). + +%% First group of reply code digits +-define(POS_PREL, 1). +-define(POS_COMPL, 2). +-define(POS_INTERM, 3). +-define(TRANS_NEG_COMPL, 4). +-define(PERM_NEG_COMPL, 5). +%% Second group of reply code digits +-define(SYNTAX,0). +-define(INFORMATION,1). +-define(CONNECTION,2). +-define(AUTH_ACC,3). +-define(UNSPEC,4). +-define(FILE_SYSTEM,5). + +%%%========================================================================= +%%% INTERNAL API +%%%========================================================================= + +%%-------------------------------------------------------------------------- +%% parse_lines(Data, AccLines, StatusCode) -> {ok, Lines} | +%% {continue, {Data, +%% AccLines, StatusCode}} +%% +%% Data = binary() - data recived on the control connection from the +%% ftp-server. +%% AccLines = [string()] +%% StatusCode = start | {byte(), byte(), byte()} | finish - +%% Indicates where in the parsing process we are. +%% start - (looking for the status code of the message) +%% {byte(), byte(), byte()} - status code found, now +%% looking for the last line indication. +%% finish - now on the last line. +%% Description: Parses a ftp control response message. +%% "A reply is defined to contain the 3-digit code, followed by Space +%% <SP>, followed by one line of text (where some maximum line length +%% has been specified), and terminated by the Telnet end-of-line +%% code (CRLF), or a so called multilined reply for example: +%% +%% 123-First line +%% Second line +%% 234 A line beginning with numbers +%% 123 The last line +%% +%% The user-process then simply needs to search for the second +%% occurrence of the same reply code, followed by <SP> (Space), at +%% the beginning of a line, and ignore all intermediary lines. If +%% an intermediary line begins with a 3-digit number, the Server +%% will pad the front to avoid confusion. +%%-------------------------------------------------------------------------- + +%% Make sure we received the first 4 bytes so we know how to parse +%% the FTP server response e.i. is the response composed of one +%% or multiple lines. +parse_lines(Bin, Lines, start) when size(Bin) < 4 -> + {continue, {Bin, Lines, start}}; +%% Multiple lines exist +parse_lines(<<C1, C2, C3, $-, Rest/binary>>, Lines, start) -> + parse_lines(Rest, [$-, C3, C2, C1 | Lines], {C1, C2, C3}); +%% Only one line exists +parse_lines(<<C1, C2, C3, ?WHITE_SPACE, Bin/binary>>, Lines, start) -> + parse_lines(Bin, [?WHITE_SPACE, C3, C2, C1 | Lines], finish); + +%% Last line found +parse_lines(<<C1, C2, C3, ?WHITE_SPACE, Rest/binary>>, Lines, {C1, C2, C3}) -> + parse_lines(Rest, [?WHITE_SPACE, C3, C2, C1 | Lines], finish); +%% Potential end found wait for more data +parse_lines(<<C1, C2, C3>> = Bin, Lines, {C1, C2, C3}) -> + {continue, {Bin, Lines, {C1, C2, C3}}}; +%% Intermidate line begining with status code +parse_lines(<<C1, C2, C3, Rest/binary>>, Lines, {C1, C2, C3}) -> + parse_lines(Rest, [C3, C2, C1 | Lines], {C1, C2, C3}); + +%% Potential last line wait for more data +parse_lines(<<C1, C2>> = Data, Lines, {C1, C2, _} = StatusCode) -> + {continue, {Data, Lines, StatusCode}}; +parse_lines(<<C1>> = Data, Lines, {C1, _, _} = StatusCode) -> + {continue, {Data, Lines, StatusCode}}; +parse_lines(<<>> = Data, Lines, {_,_,_} = StatusCode) -> + {continue, {Data, Lines, StatusCode}}; +%% Part of the multiple lines +parse_lines(<<Octet, Rest/binary>>, Lines, {_,_, _} = StatusCode) -> + parse_lines(Rest, [Octet | Lines], StatusCode); + +%% End of FTP server response found +parse_lines(<<?CR, ?LF>>, Lines, finish) -> + {ok, lists:reverse([?LF, ?CR | Lines]), <<>>}; +parse_lines(<<?CR, ?LF, Rest/binary>>, Lines, finish) -> + {ok, lists:reverse([?LF, ?CR | Lines]), Rest}; + +%% Potential end found wait for more data +parse_lines(<<?CR>> = Data, Lines, finish) -> + {continue, {Data, Lines, finish}}; +parse_lines(<<>> = Data, Lines, finish) -> + {continue, {Data, Lines, finish}}; +%% Part of last line +parse_lines(<<Octet, Rest/binary>>, Lines, finish) -> + parse_lines(Rest, [Octet | Lines], finish). + +%%-------------------------------------------------------------------------- +%% interpret(Lines) -> {Status, Text} +%% Lines = [byte(), byte(), byte() | Text] - ftp server response as +%% returned by parse_lines/3 +%% Stauts = atom() (see interpret_status/3) +%% Text = [string()] +%% +%% Description: Create nicer data to match on. +%%-------------------------------------------------------------------------- +interpret([Didgit1, Didgit2, Didgit3 | Data]) -> + Code1 = Didgit1 - $0, + Code2 = Didgit2 - $0, + Code3 = Didgit3 - $0, + {interpret_status(Code1, Code2, Code3), Data}. + +%%-------------------------------------------------------------------------- +%% error_string(Error) -> string() +%% Error = {error, term()} | term() +%% +%% Description: Translates error codes into strings intended for +%% human interpretation. +%%-------------------------------------------------------------------------- +error_string({error, Reason}) -> + error_string(Reason); + +error_string(echunk) -> "Synchronisation error during chunk sending."; +error_string(eclosed) -> "Session has been closed."; +error_string(econn) -> "Connection to remote server prematurely closed."; +error_string(eexists) ->"File or directory already exists."; +error_string(ehost) -> "Host not found, FTP server not found, " + "or connection rejected."; +error_string(elogin) -> "User not logged in."; +error_string(enotbinary) -> "Term is not a binary."; +error_string(epath) -> "No such file or directory, already exists, " + "or permission denied."; +error_string(etype) -> "No such type."; +error_string(euser) -> "User name or password not valid."; +error_string(etnospc) -> "Insufficient storage space in system."; +error_string(epnospc) -> "Exceeded storage allocation " + "(for current directory or dataset)."; +error_string(efnamena) -> "File name not allowed."; +error_string(Reason) -> + lists:flatten(io_lib:format("Unknown error: ~w", [Reason])). + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%% Positive Preleminary Reply +interpret_status(?POS_PREL,_,_) -> pos_prel; +%% Positive Completion Reply +interpret_status(?POS_COMPL,_,_) -> pos_compl; +%% Positive Intermediate Reply nedd account +interpret_status(?POS_INTERM,?AUTH_ACC,2) -> pos_interm_acct; +%% Positive Intermediate Reply +interpret_status(?POS_INTERM,_,_) -> pos_interm; +%% No storage area no action taken +interpret_status(?TRANS_NEG_COMPL,?FILE_SYSTEM,2) -> etnospc; +%% Temporary Error, no action taken +interpret_status(?TRANS_NEG_COMPL,_,_) -> trans_neg_compl; +%% Permanent disk space error, the user shall not try again +interpret_status(?PERM_NEG_COMPL,?FILE_SYSTEM,0) -> epath; +interpret_status(?PERM_NEG_COMPL,?FILE_SYSTEM,2) -> epnospc; +interpret_status(?PERM_NEG_COMPL,?FILE_SYSTEM,3) -> efnamena; +interpret_status(?PERM_NEG_COMPL,_,_) -> perm_neg_compl. + diff --git a/lib/inets/src/ftp/ftp_sup.erl b/lib/inets/src/ftp/ftp_sup.erl new file mode 100644 index 0000000000..547170b671 --- /dev/null +++ b/lib/inets/src/ftp/ftp_sup.erl @@ -0,0 +1,59 @@ +%% +%% %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 ftp hangs under inets_sup. +%%---------------------------------------------------------------------- +-module(ftp_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). +-export([start_child/1]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +start_child(Args) -> + supervisor:start_child(?MODULE, Args). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init(_) -> + RestartStrategy = simple_one_for_one, + MaxR = 0, + MaxT = 3600, + + Name = undefined, % As simple_one_for_one is used. + StartFunc = {ftp, start_link, []}, + Restart = temporary, % E.g. should not be restarted + Shutdown = 4000, + Modules = [ftp], + Type = worker, + + ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, + {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}. diff --git a/lib/inets/src/http_client/Makefile b/lib/inets/src/http_client/Makefile new file mode 100644 index 0000000000..23170f439f --- /dev/null +++ b/lib/inets/src/http_client/Makefile @@ -0,0 +1,102 @@ +# +# %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 = \ + http \ + http_cookie \ + httpc_handler \ + httpc_manager \ + httpc_sup \ + httpc_handler_sup \ + httpc_profile_sup \ + httpc_response \ + httpc_request \ + http_uri \ + +HRL_FILES = httpc_internal.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_client/http.erl b/lib/inets/src/http_client/http.erl new file mode 100644 index 0000000000..ce5d7723f0 --- /dev/null +++ b/lib/inets/src/http_client/http.erl @@ -0,0 +1,801 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-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: +%%% This version of the HTTP/1.1 client supports: +%%% - RFC 2616 HTTP 1.1 client part +%%% - RFC 2818 HTTP Over TLS + +-module(http). +-behaviour(inets_service). + +%% API +-export([request/1, request/2, request/4, request/5, + cancel_request/1, cancel_request/2, + set_option/2, set_option/3, + set_options/1, set_options/2, + verify_cookies/2, verify_cookies/3, cookie_header/1, + cookie_header/2, stream_next/1, + default_profile/0]). + +%% Behavior callbacks +-export([start_standalone/1, start_service/1, + stop_service/1, services/0, service_info/1]). + +-include("http_internal.hrl"). +-include("httpc_internal.hrl"). + +-define(DEFAULT_PROFILE, default). + + +%%%========================================================================= +%%% API +%%%========================================================================= + +%%-------------------------------------------------------------------------- +%% request(Url [, Profile]) -> +%% {ok, {StatusLine, Headers, Body}} | {error,Reason} +%% +%% Url - string() +%% Description: Calls request/4 with default values. +%%-------------------------------------------------------------------------- + +request(Url) -> + request(Url, default_profile()). + +request(Url, Profile) -> + request(get, {Url, []}, [], [], Profile). + + +%%-------------------------------------------------------------------------- +%% request(Method, Request, HTTPOptions, Options [, Profile]) -> +%% {ok, {StatusLine, Headers, Body}} | {ok, {Status, Body}} | +%% {ok, RequestId} | {error,Reason} | {ok, {saved_as, FilePath} +%% +%% Method - atom() = head | get | put | post | trace | options| delete +%% Request - {Url, Headers} | {Url, Headers, ContentType, Body} +%% Url - string() +%% HTTPOptions - [HttpOption] +%% HTTPOption - {timeout, Time} | {connect_timeout, Time} | +%% {ssl, SSLOptions} | {proxy_auth, {User, Password}} +%% Ssloptions = [SSLOption] +%% SSLOption = {verify, code()} | {depth, depth()} | {certfile, path()} | +%% {keyfile, path()} | {password, string()} | {cacertfile, path()} | +%% {ciphers, string()} +%% Options - [Option] +%% Option - {sync, Boolean} | {body_format, BodyFormat} | +%% {full_result, Boolean} | {stream, To} | +%% {headers_as_is, Boolean} +%% StatusLine = {HTTPVersion, StatusCode, ReasonPhrase}</v> +%% HTTPVersion = string() +%% StatusCode = integer() +%% ReasonPhrase = string() +%% Headers = [Header] +%% Header = {Field, Value} +%% Field = string() +%% Value = string() +%% Body = string() | binary() - HTLM-code +%% +%% Description: Sends a HTTP-request. The function can be both +%% syncronus and asynchronous in the later case the function will +%% return {ok, RequestId} and later on a message will be sent to the +%% calling process on the format {http, {RequestId, {StatusLine, +%% Headers, Body}}} or {http, {RequestId, {error, Reason}}} +%%-------------------------------------------------------------------------- + +request(Method, Request, HttpOptions, Options) -> + request(Method, Request, HttpOptions, Options, default_profile()). + +request(Method, {Url, Headers}, HTTPOptions, Options, Profile) + when (Method =:= options) orelse + (Method =:= get) orelse + (Method =:= head) orelse + (Method =:= delete) orelse + (Method =:= trace) -> + case http_uri:parse(Url) of + {error, Reason} -> + {error, Reason}; + ParsedUrl -> + handle_request(Method, Url, ParsedUrl, Headers, [], [], + HTTPOptions, Options, Profile) + end; + +request(Method, {Url,Headers,ContentType,Body}, HTTPOptions, Options, Profile) + when (Method =:= post) orelse (Method =:= put) -> + case http_uri:parse(Url) of + {error, Reason} -> + {error, Reason}; + ParsedUrl -> + handle_request(Method, Url, + ParsedUrl, Headers, ContentType, Body, + HTTPOptions, Options, Profile) + end. + +%%-------------------------------------------------------------------------- +%% request(RequestId) -> ok +%% RequestId - As returned by request/4 +%% +%% Description: Cancels a HTTP-request. +%%------------------------------------------------------------------------- +cancel_request(RequestId) -> + cancel_request(RequestId, default_profile()). + +cancel_request(RequestId, Profile) -> + ok = httpc_manager:cancel_request(RequestId, profile_name(Profile)), + receive + %% If the request was allready fullfilled throw away the + %% answer as the request has been canceled. + {http, {RequestId, _}} -> + ok + after 0 -> + ok + end. + + +set_option(Key, Value) -> + set_option(Key, Value, default_profile()). + +set_option(Key, Value, Profile) -> + set_options([{Key, Value}], Profile). + + +%%-------------------------------------------------------------------------- +%% set_options(Options [, Profile]) -> ok | {error, Reason} +%% Options - [Option] +%% Profile - atom() +%% Option - {proxy, {Proxy, NoProxy}} | {max_sessions, MaxSessions} | +%% {max_pipeline_length, MaxPipeline} | +%% {pipeline_timeout, PipelineTimeout} | {cookies, CookieMode} | +%% {ipfamily, IpFamily} +%% Proxy - {Host, Port} +%% NoProxy - [Domain | HostName | IPAddress] +%% MaxSessions, MaxPipeline, PipelineTimeout = integer() +%% CookieMode - enabled | disabled | verify +%% IpFamily - inet | inet6 | inet6fb4 +%% Description: Informs the httpc_manager of the new settings. +%%------------------------------------------------------------------------- +set_options(Options) -> + set_options(Options, default_profile()). +set_options(Options, Profile) -> + case validate_options(Options) of + {ok, Opts} -> + try httpc_manager:set_options(Opts, profile_name(Profile)) of + Result -> + Result + catch + exit:{noproc, _} -> + {error, inets_not_started} + end; + {error, Reason} -> + {error, Reason} + end. + + +%%-------------------------------------------------------------------------- +%% verify_cookies(SetCookieHeaders, Url [, Profile]) -> ok | {error, reason} +%% +%% +%% Description: Store the cookies from <SetCookieHeaders> +%% in the cookie database +%% for the profile <Profile>. This function shall be used when the option +%% cookie is set to verify. +%%------------------------------------------------------------------------- +verify_cookies(SetCookieHeaders, Url) -> + verify_cookies(SetCookieHeaders, Url, default_profile()). + +verify_cookies(SetCookieHeaders, Url, Profile) -> + {_, _, Host, Port, Path, _} = http_uri:parse(Url), + ProfileName = profile_name(Profile), + Cookies = http_cookie:cookies(SetCookieHeaders, Path, Host), + try httpc_manager:store_cookies(Cookies, {Host, Port}, ProfileName) of + _ -> + ok + catch + exit:{noproc, _} -> + {error, {not_started, Profile}} + end. + +%%-------------------------------------------------------------------------- +%% cookie_header(Url [, Profile]) -> Header | {error, Reason} +%% +%% Description: Returns the cookie header that would be sent when making +%% a request to <Url>. +%%------------------------------------------------------------------------- +cookie_header(Url) -> + cookie_header(Url, default_profile()). + +cookie_header(Url, Profile) -> + try httpc_manager:cookies(Url, profile_name(Profile)) of + Header -> + Header + catch + exit:{noproc, _} -> + {error, {not_started, Profile}} + end. + + +stream_next(Pid) -> + httpc_handler:stream_next(Pid). + +%%%======================================================================== +%%% Behavior callbacks +%%%======================================================================== +start_standalone(PropList) -> + case proplists:get_value(profile, PropList) of + undefined -> + {error, no_profile}; + Profile -> + Dir = + proplists:get_value(data_dir, PropList, only_session_cookies), + httpc_manager:start_link({Profile, Dir}, stand_alone) + end. + +start_service(Config) -> + httpc_profile_sup:start_child(Config). + +stop_service(Profile) when is_atom(Profile) -> + httpc_profile_sup:stop_child(Profile); +stop_service(Pid) when is_pid(Pid) -> + case service_info(Pid) of + {ok, [{profile, Profile}]} -> + stop_service(Profile); + Error -> + Error + end. + +services() -> + [{httpc, Pid} || {_, Pid, _, _} <- + supervisor:which_children(httpc_profile_sup)]. +service_info(Pid) -> + try [{ChildName, ChildPid} || + {ChildName, ChildPid, _, _} <- + supervisor:which_children(httpc_profile_sup)] of + Children -> + child_name2info(child_name(Pid, Children)) + catch + exit:{noproc, _} -> + {error, service_not_available} + end. + + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +handle_request(Method, Url, + {Scheme, UserInfo, Host, Port, Path, Query}, + Headers, ContentType, Body, + HTTPOptions0, Options, Profile) -> + + HTTPOptions = http_options(HTTPOptions0), + Sync = proplists:get_value(sync, Options, true), + NewHeaders = lists:map(fun({Key, Val}) -> + {http_util:to_lower(Key), Val} end, + Headers), + Stream = proplists:get_value(stream, Options, none), + case {Sync, Stream} of + {true, self} -> + {error, streaming_error}; + _ -> + RecordHeaders = header_record(NewHeaders, + #http_request_h{}, + Host, + HTTPOptions#http_options.version), + Request = #request{from = self(), + scheme = Scheme, + address = {Host,Port}, + path = Path, + pquery = Query, + method = Method, + headers = RecordHeaders, + content = {ContentType,Body}, + settings = HTTPOptions, + abs_uri = Url, + userinfo = UserInfo, + stream = Stream, + headers_as_is = headers_as_is(Headers, Options)}, + try httpc_manager:request(Request, profile_name(Profile)) of + {ok, RequestId} -> + handle_answer(RequestId, Sync, Options); + {error, Reason} -> + {error, Reason} + catch + error:{noproc, _} -> + {error, {not_started, Profile}} + end + end. + + +handle_answer(RequestId, false, _) -> + {ok, RequestId}; +handle_answer(RequestId, true, Options) -> + receive + {http, {RequestId, saved_to_file}} -> + {ok, saved_to_file}; + {http, {RequestId, Result = {_,_,_}}} -> + return_answer(Options, Result); + {http, {RequestId, {error, Reason}}} -> + {error, Reason} + end. + +return_answer(Options, {{"HTTP/0.9",_,_}, _, BinBody}) -> + Body = format_body(BinBody, Options), + {ok, Body}; + +return_answer(Options, {StatusLine, Headers, BinBody}) -> + + Body = format_body(BinBody, Options), + + case proplists:get_value(full_result, Options, true) of + true -> + {ok, {StatusLine, Headers, Body}}; + false -> + {_, Status, _} = StatusLine, + {ok, {Status, Body}} + end. + +format_body(BinBody, Options) -> + case proplists:get_value(body_format, Options, string) of + string -> + binary_to_list(BinBody); + _ -> + BinBody + end. + +%% This options is a workaround for http servers that do not follow the +%% http standard and have case sensative header parsing. Should only be +%% used if there is no other way to communicate with the server or for +%% testing purpose. +headers_as_is(Headers, Options) -> + case proplists:get_value(headers_as_is, Options, false) of + false -> + []; + true -> + Headers + end. + + +http_options(HttpOptions) -> + HttpOptionsDefault = http_options_default(), + http_options(HttpOptionsDefault, HttpOptions, #http_options{}). + +http_options([], [], Acc) -> + Acc; +http_options([], HttpOptions, Acc) -> + Fun = fun(BadOption) -> + Report = io_lib:format("Invalid option ~p ignored ~n", + [BadOption]), + error_logger:info_report(Report) + end, + lists:foreach(Fun, HttpOptions), + Acc; +http_options([{Tag, Default, Idx, Post} | Defaults], HttpOptions, Acc) -> + case lists:keysearch(Tag, 1, HttpOptions) of + {value, {Tag, Val0}} -> + case Post(Val0) of + {ok, Val} -> + Acc2 = setelement(Idx, Acc, Val), + HttpOptions2 = lists:keydelete(Tag, 1, HttpOptions), + http_options(Defaults, HttpOptions2, Acc2); + error -> + Report = io_lib:format("Invalid option ~p:~p ignored ~n", + [Tag, Val0]), + error_logger:info_report(Report), + HttpOptions2 = lists:keydelete(Tag, 1, HttpOptions), + http_options(Defaults, HttpOptions2, Acc) + end; + false -> + DefaultVal = + case Default of + {value, Val} -> + Val; + {field, DefaultIdx} -> + element(DefaultIdx, Acc) + end, + Acc2 = setelement(Idx, Acc, DefaultVal), + http_options(Defaults, HttpOptions, Acc2) + end. + +http_options_default() -> + VersionPost = + fun(Value) when is_atom(Value) -> + {ok, http_util:to_upper(atom_to_list(Value))}; + (Value) when is_list(Value) -> + {ok, http_util:to_upper(Value)}; + (_) -> + error + end, + TimeoutPost = fun(Value) when is_integer(Value) andalso (Value >= 0) -> + {ok, Value}; + (infinity = Value) -> + {ok, Value}; + (_) -> + error + end, + AutoRedirectPost = fun(Value) when (Value =:= true) orelse + (Value =:= false) -> + {ok, Value}; + (_) -> + error + end, + SslPost = fun(Value) when is_list(Value) -> + {ok, Value}; + (_) -> + error + end, + ProxyAuthPost = fun({User, Passwd} = Value) when is_list(User) andalso + is_list(Passwd) -> + {ok, Value}; + (_) -> + error + end, + RelaxedPost = fun(Value) when (Value =:= true) orelse + (Value =:= false) -> + {ok, Value}; + (_) -> + error + end, + ConnTimeoutPost = + fun(Value) when is_integer(Value) andalso (Value >= 0) -> + {ok, Value}; + (infinity = Value) -> + {ok, Value}; + (_) -> + error + end, + [ + {version, {value, "HTTP/1.1"}, #http_options.version, VersionPost}, + {timeout, {value, ?HTTP_REQUEST_TIMEOUT}, #http_options.timeout, TimeoutPost}, + {autoredirect, {value, true}, #http_options.autoredirect, AutoRedirectPost}, + {ssl, {value, []}, #http_options.ssl, SslPost}, + {proxy_auth, {value, undefined}, #http_options.proxy_auth, ProxyAuthPost}, + {relaxed, {value, false}, #http_options.relaxed, RelaxedPost}, + %% this field has to be *after* the timeout field (as that field is used for the default value) + {connect_timeout, {field, #http_options.timeout}, #http_options.connect_timeout, ConnTimeoutPost} + ]. + +validate_options(Options) -> + (catch validate_options(Options, [])). + +validate_options([], ValidateOptions) -> + {ok, lists:reverse(ValidateOptions)}; + +validate_options([{proxy, Proxy} = Opt| Tail], Acc) -> + validate_proxy(Proxy), + validate_options(Tail, [Opt | Acc]); + +validate_options([{max_sessions, Value} = Opt| Tail], Acc) -> + validate_max_sessions(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{keep_alive_timeout, Value} = Opt| Tail], Acc) -> + validate_keep_alive_timeout(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{max_keep_alive_length, Value} = Opt| Tail], Acc) -> + validate_max_keep_alive_length(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{pipeline_timeout, Value} = Opt| Tail], Acc) -> + validate_pipeline_timeout(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{max_pipeline_length, Value} = Opt| Tail], Acc) -> + validate_max_pipeline_length(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{cookies, Value} = Opt| Tail], Acc) -> + validate_cookies(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{ipfamily, Value} = Opt| Tail], Acc) -> + validate_ipfamily(Value), + validate_options(Tail, [Opt | Acc]); + +%% For backward compatibillity +validate_options([{ipv6, Value}| Tail], Acc) -> + NewValue = validate_ipv6(Value), + Opt = {ipfamily, NewValue}, + validate_options(Tail, [Opt | Acc]); + +validate_options([{ip, Value} = Opt| Tail], Acc) -> + validate_ip(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{port, Value} = Opt| Tail], Acc) -> + validate_port(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{verbose, Value} = Opt| Tail], Acc) -> + validate_verbose(Value), + validate_options(Tail, [Opt | Acc]); + +validate_options([{_, _} = Opt| _], _Acc) -> + {error, {not_an_option, Opt}}. + + +validate_proxy({{ProxyHost, ProxyPort}, NoProxy} = Proxy) + when is_list(ProxyHost) andalso + is_integer(ProxyPort) andalso + is_list(NoProxy) -> + Proxy; +validate_proxy(BadProxy) -> + bad_option(proxy, BadProxy). + +validate_max_sessions(Value) when is_integer(Value) andalso (Value >= 0) -> + Value; +validate_max_sessions(BadValue) -> + bad_option(max_sessions, BadValue). + +validate_keep_alive_timeout(Value) when is_integer(Value) andalso (Value >= 0) -> + Value; +validate_keep_alive_timeout(infinity = Value) -> + Value; +validate_keep_alive_timeout(BadValue) -> + bad_option(keep_alive_timeout, BadValue). + +validate_max_keep_alive_length(Value) when is_integer(Value) andalso (Value >= 0) -> + Value; +validate_max_keep_alive_length(BadValue) -> + bad_option(max_keep_alive_length, BadValue). + +validate_pipeline_timeout(Value) when is_integer(Value) -> + Value; +validate_pipeline_timeout(infinity = Value) -> + Value; +validate_pipeline_timeout(BadValue) -> + bad_option(pipeline_timeout, BadValue). + +validate_max_pipeline_length(Value) when is_integer(Value) -> + Value; +validate_max_pipeline_length(BadValue) -> + bad_option(max_pipeline_length, BadValue). + +validate_cookies(Value) + when ((Value =:= enabled) orelse + (Value =:= disabled) orelse + (Value =:= verify)) -> + Value; +validate_cookies(BadValue) -> + bad_option(cookies, BadValue). + +validate_ipv6(Value) when (Value =:= enabled) orelse (Value =:= disabled) -> + case Value of + enabled -> + inet6fb4; + disabled -> + inet + end; +validate_ipv6(BadValue) -> + bad_option(ipv6, BadValue). + +validate_ipfamily(Value) + when (Value =:= inet) orelse (Value =:= inet6) orelse (Value =:= inet6fb4) -> + Value; +validate_ipfamily(BadValue) -> + bad_option(ipfamily, BadValue). + +validate_ip(Value) + when is_tuple(Value) andalso ((size(Value) =:= 4) orelse (size(Value) =:= 8)) -> + Value; +validate_ip(BadValue) -> + bad_option(ip, BadValue). + +validate_port(Value) when is_integer(Value) -> + Value; +validate_port(BadValue) -> + bad_option(port, BadValue). + +validate_verbose(Value) + when ((Value =:= false) orelse + (Value =:= verbose) orelse + (Value =:= debug) orelse + (Value =:= trace)) -> + ok; +validate_verbose(BadValue) -> + bad_option(verbose, BadValue). + +bad_option(Option, BadValue) -> + throw({error, {bad_option, Option, BadValue}}). + + + +header_record([], RequestHeaders, Host, Version) -> + validate_headers(RequestHeaders, Host, Version); +header_record([{"cache-control", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'cache-control' = Val}, + Host, Version); +header_record([{"connection", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{connection = Val}, Host, + Version); +header_record([{"date", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{date = Val}, Host, + Version); +header_record([{"pragma", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{pragma = Val}, Host, + Version); +header_record([{"trailer", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{trailer = Val}, Host, + Version); +header_record([{"transfer-encoding", Val} | Rest], RequestHeaders, Host, + Version) -> + header_record(Rest, + RequestHeaders#http_request_h{'transfer-encoding' = Val}, + Host, Version); +header_record([{"upgrade", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{upgrade = Val}, Host, + Version); +header_record([{"via", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{via = Val}, Host, + Version); +header_record([{"warning", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{warning = Val}, Host, + Version); +header_record([{"accept", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{accept = Val}, Host, + Version); +header_record([{"accept-charset", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'accept-charset' = Val}, + Host, Version); +header_record([{"accept-encoding", Val} | Rest], RequestHeaders, Host, + Version) -> + header_record(Rest, RequestHeaders#http_request_h{'accept-encoding' = Val}, + Host, Version); +header_record([{"accept-language", Val} | Rest], RequestHeaders, Host, + Version) -> + header_record(Rest, RequestHeaders#http_request_h{'accept-language' = Val}, + Host, Version); +header_record([{"authorization", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{authorization = Val}, + Host, Version); +header_record([{"expect", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{expect = Val}, Host, + Version); +header_record([{"from", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{from = Val}, Host, + Version); +header_record([{"host", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{host = Val}, Host, + Version); +header_record([{"if-match", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'if-match' = Val}, + Host, Version); +header_record([{"if-modified-since", Val} | Rest], RequestHeaders, Host, + Version) -> + header_record(Rest, + RequestHeaders#http_request_h{'if-modified-since' = Val}, + Host, Version); +header_record([{"if-none-match", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'if-none-match' = Val}, + Host, Version); +header_record([{"if-range", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'if-range' = Val}, + Host, Version); + +header_record([{"if-unmodified-since", Val} | Rest], RequestHeaders, Host, + Version) -> + header_record(Rest, RequestHeaders#http_request_h{'if-unmodified-since' + = Val}, Host, Version); +header_record([{"max-forwards", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'max-forwards' = Val}, + Host, Version); +header_record([{"proxy-authorization", Val} | Rest], RequestHeaders, Host, + Version) -> + header_record(Rest, RequestHeaders#http_request_h{'proxy-authorization' + = Val}, Host, Version); +header_record([{"range", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{range = Val}, Host, + Version); +header_record([{"referer", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{referer = Val}, Host, + Version); +header_record([{"te", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{te = Val}, Host, + Version); +header_record([{"user-agent", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'user-agent' = Val}, + Host, Version); +header_record([{"allow", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{allow = Val}, Host, + Version); +header_record([{"content-encoding", Val} | Rest], RequestHeaders, Host, + Version) -> + header_record(Rest, + RequestHeaders#http_request_h{'content-encoding' = Val}, + Host, Version); +header_record([{"content-language", Val} | Rest], RequestHeaders, + Host, Version) -> + header_record(Rest, + RequestHeaders#http_request_h{'content-language' = Val}, + Host, Version); +header_record([{"content-length", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'content-length' = Val}, + Host, Version); +header_record([{"content-location", Val} | Rest], RequestHeaders, + Host, Version) -> + header_record(Rest, + RequestHeaders#http_request_h{'content-location' = Val}, + Host, Version); +header_record([{"content-md5", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'content-md5' = Val}, + Host, Version); +header_record([{"content-range", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'content-range' = Val}, + Host, Version); +header_record([{"content-type", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'content-type' = Val}, + Host, Version); +header_record([{"expires", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{expires = Val}, Host, + Version); +header_record([{"last-modified", Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{'last-modified' = Val}, + Host, Version); +header_record([{Key, Val} | Rest], RequestHeaders, Host, Version) -> + header_record(Rest, RequestHeaders#http_request_h{ + other = [{Key, Val} | + RequestHeaders#http_request_h.other]}, + Host, Version). + +validate_headers(RequestHeaders = #http_request_h{te = undefined}, Host, + "HTTP/1.1" = Version) -> + validate_headers(RequestHeaders#http_request_h{te = ""}, Host, + "HTTP/1.1" = Version); +validate_headers(RequestHeaders = #http_request_h{host = undefined}, + Host, "HTTP/1.1" = Version) -> + validate_headers(RequestHeaders#http_request_h{host = Host}, Host, Version); +validate_headers(RequestHeaders, _, _) -> + RequestHeaders. + + +default_profile() -> + ?DEFAULT_PROFILE. + +profile_name(?DEFAULT_PROFILE) -> + httpc_manager; +profile_name(Pid) when is_pid(Pid) -> + Pid; +profile_name(Profile) -> + list_to_atom("httpc_manager_" ++ atom_to_list(Profile)). + +child_name2info(undefined) -> + {error, no_such_service}; +child_name2info(httpc_manager) -> + {ok, [{profile, default}]}; +child_name2info({http, Profile}) -> + {ok, [{profile, Profile}]}. + +child_name(_, []) -> + undefined; +child_name(Pid, [{Name, Pid} | _]) -> + Name; +child_name(Pid, [_ | Children]) -> + child_name(Pid, Children). + +%% d(F) -> +%% d(F, []). + +%% d(F, A) -> +%% d(get(dbg), F, A). + +%% d(true, F, A) -> +%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]); +%% d(_, _, _) -> +%% ok. + diff --git a/lib/inets/src/http_client/http_cookie.erl b/lib/inets/src/http_client/http_cookie.erl new file mode 100644 index 0000000000..e091070f72 --- /dev/null +++ b/lib/inets/src/http_client/http_cookie.erl @@ -0,0 +1,391 @@ +%% +%% %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% +%% +%% Description: Cookie handling according to RFC 2109 + +-module(http_cookie). + +-include("httpc_internal.hrl"). + +-export([header/4, cookies/3, open_cookie_db/1, close_cookie_db/1, insert/2]). + +%%%========================================================================= +%%% API +%%%========================================================================= +header(Scheme, {Host, _}, Path, CookieDb) -> + case lookup_cookies(Host, Path, CookieDb) of + [] -> + {"cookie", ""}; + Cookies -> + {"cookie", cookies_to_string(Scheme, Cookies)} + end. + +cookies(Headers, RequestPath, RequestHost) -> + Cookies = parse_set_cookies(Headers, {RequestPath, RequestHost}), + accept_cookies(Cookies, RequestPath, RequestHost). + +open_cookie_db({{_, only_session_cookies}, SessionDbName}) -> + EtsDb = ets:new(SessionDbName, [protected, bag, + {keypos, #http_cookie.domain}]), + {undefined, EtsDb}; + +open_cookie_db({{DbName, Dbdir}, SessionDbName}) -> + File = filename:join(Dbdir, atom_to_list(DbName)), + {ok, DetsDb} = dets:open_file(DbName, [{keypos, #http_cookie.domain}, + {type, bag}, + {file, File}, + {ram_file, true}]), + EtsDb = ets:new(SessionDbName, [protected, bag, + {keypos, #http_cookie.domain}]), + {DetsDb, EtsDb}. + +close_cookie_db({undefined, EtsDb}) -> + ets:delete(EtsDb); + +close_cookie_db({DetsDb, EtsDb}) -> + dets:close(DetsDb), + ets:delete(EtsDb). + +%% If no persistent cookie database is defined we +%% treat all cookies as if they where session cookies. +insert(Cookie = #http_cookie{max_age = Int}, + Dbs = {undefined, _}) when is_integer(Int) -> + insert(Cookie#http_cookie{max_age = session}, Dbs); + +insert(Cookie = #http_cookie{domain = Key, name = Name, + path = Path, max_age = session}, + Db = {_, CookieDb}) -> + case ets:match_object(CookieDb, #http_cookie{domain = Key, + name = Name, + path = Path, + _ = '_'}) of + [] -> + ets:insert(CookieDb, Cookie); + [NewCookie] -> + delete(NewCookie, Db), + ets:insert(CookieDb, Cookie) + end, + ok; +insert(#http_cookie{domain = Key, name = Name, + path = Path, max_age = 0}, + Db = {CookieDb, _}) -> + case dets:match_object(CookieDb, #http_cookie{domain = Key, + name = Name, + path = Path, + _ = '_'}) of + [] -> + ok; + [NewCookie] -> + delete(NewCookie, Db) + end, + ok; +insert(Cookie = #http_cookie{domain = Key, name = Name, path = Path}, + Db = {CookieDb, _}) -> + case dets:match_object(CookieDb, #http_cookie{domain = Key, + name = Name, + path = Path, + _ = '_'}) of + [] -> + dets:insert(CookieDb, Cookie); + [NewCookie] -> + delete(NewCookie, Db), + dets:insert(CookieDb, Cookie) + end, + ok. + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +lookup_cookies(Key, {undefined, Ets}) -> + ets:match_object(Ets, #http_cookie{domain = Key, + _ = '_'}); +lookup_cookies(Key, {Dets,Ets}) -> + SessionCookies = ets:match_object(Ets, #http_cookie{domain = Key, + _ = '_'}), + Cookies = dets:match_object(Dets, #http_cookie{domain = Key, + _ = '_'}), + Cookies ++ SessionCookies. + +delete(Cookie = #http_cookie{max_age = session}, {_, CookieDb}) -> + ets:delete_object(CookieDb, Cookie); +delete(Cookie, {CookieDb, _}) -> + dets:delete_object(CookieDb, Cookie). + +lookup_cookies(Host, Path, Db) -> + Cookies = + case http_util:is_hostname(Host) of + true -> + HostCookies = lookup_cookies(Host, Db), + [_| DomainParts] = string:tokens(Host, "."), + lookup_domain_cookies(DomainParts, Db, HostCookies); + false -> % IP-adress + lookup_cookies(Host, Db) + end, + ValidCookies = valid_cookies(Cookies, [], Db), + lists:filter(fun(Cookie) -> + lists:prefix(Cookie#http_cookie.path, Path) + end, ValidCookies). + +%% For instance if Host=localhost +lookup_domain_cookies([], _, AccCookies) -> + lists:flatten(AccCookies); +%% Top domains can not have cookies +lookup_domain_cookies([_], _, AccCookies) -> + lists:flatten(AccCookies); +lookup_domain_cookies([Next | DomainParts], CookieDb, AccCookies) -> + Domain = merge_domain_parts(DomainParts, [Next ++ "."]), + lookup_domain_cookies(DomainParts, CookieDb, + [lookup_cookies(Domain, CookieDb) + | AccCookies]). + +merge_domain_parts([Part], Merged) -> + lists:flatten(["." | lists:reverse([Part | Merged])]); +merge_domain_parts([Part| Rest], Merged) -> + merge_domain_parts(Rest, [".", Part | Merged]). + +cookies_to_string(Scheme, Cookies = [Cookie | _]) -> + Version = "$Version=" ++ Cookie#http_cookie.version ++ "; ", + cookies_to_string(Scheme, path_sort(Cookies), [Version]). + +cookies_to_string(_, [], CookieStrs) -> + case length(CookieStrs) of + 1 -> + ""; + _ -> + lists:flatten(lists:reverse(CookieStrs)) + end; + +cookies_to_string(https, [Cookie = #http_cookie{secure = true}| Cookies], + CookieStrs) -> + Str = case Cookies of + [] -> + cookie_to_string(Cookie); + _ -> + cookie_to_string(Cookie) ++ "; " + end, + cookies_to_string(https, Cookies, [Str | CookieStrs]); + +cookies_to_string(Scheme, [#http_cookie{secure = true}| Cookies], + CookieStrs) -> + cookies_to_string(Scheme, Cookies, CookieStrs); + +cookies_to_string(Scheme, [Cookie | Cookies], CookieStrs) -> + Str = case Cookies of + [] -> + cookie_to_string(Cookie); + _ -> + cookie_to_string(Cookie) ++ "; " + end, + cookies_to_string(Scheme, Cookies, [Str | CookieStrs]). + +cookie_to_string(Cookie = #http_cookie{name = Name, value = Value}) -> + Str = Name ++ "=" ++ Value, + add_domain(add_path(Str, Cookie), Cookie). + +add_path(Str, #http_cookie{path_default = true}) -> + Str; +add_path(Str, #http_cookie{path = Path}) -> + Str ++ "; $Path=" ++ Path. + +add_domain(Str, #http_cookie{domain_default = true}) -> + Str; +add_domain(Str, #http_cookie{domain = Domain}) -> + Str ++ "; $Domain=" ++ Domain. + +parse_set_cookies(OtherHeaders, DefaultPathDomain) -> + SetCookieHeaders = lists:foldl(fun({"set-cookie", Value}, Acc) -> + [string:tokens(Value, ",")| Acc]; + (_, Acc) -> + Acc + end, [], OtherHeaders), + + lists:flatten(lists:map(fun(CookieHeader) -> + NewHeader = + fix_netscape_cookie(CookieHeader, + []), + parse_set_cookie(NewHeader, [], + DefaultPathDomain) end, + SetCookieHeaders)). + +parse_set_cookie([], AccCookies, _) -> + AccCookies; +parse_set_cookie([CookieHeader | CookieHeaders], AccCookies, + Defaults = {DefaultPath, DefaultDomain}) -> + [CookieStr | Attributes] = case string:tokens(CookieHeader, ";") of + [CStr] -> + [CStr, ""]; + [CStr | Attr] -> + [CStr, Attr] + end, + Pos = string:chr(CookieStr, $=), + Name = string:substr(CookieStr, 1, Pos - 1), + Value = string:substr(CookieStr, Pos + 1), + Cookie = #http_cookie{name = string:strip(Name), + value = string:strip(Value)}, + NewAttributes = parse_set_cookie_attributes(Attributes), + TmpCookie = cookie_attributes(NewAttributes, Cookie), + %% Add runtime defult values if necessary + NewCookie = domain_default(path_default(TmpCookie, DefaultPath), + DefaultDomain), + parse_set_cookie(CookieHeaders, [NewCookie | AccCookies], Defaults). + +parse_set_cookie_attributes([]) -> + []; +parse_set_cookie_attributes([Attributes]) -> + lists:map(fun(Attr) -> + [AttrName, AttrValue] = + case string:tokens(Attr, "=") of + %% All attributes have the form + %% Name=Value except "secure"! + [Name] -> + [Name, ""]; + [Name, Value] -> + [Name, Value]; + %% Anything not expected will be + %% disregarded + _ -> + ["Dummy",""] + end, + {http_util:to_lower(string:strip(AttrName)), + string:strip(AttrValue)} + end, Attributes). + +cookie_attributes([], Cookie) -> + Cookie; +cookie_attributes([{"comment", Value}| Attributes], Cookie) -> + cookie_attributes(Attributes, + Cookie#http_cookie{comment = Value}); +cookie_attributes([{"domain", Value}| Attributes], Cookie) -> + cookie_attributes(Attributes, + Cookie#http_cookie{domain = Value}); +cookie_attributes([{"max-age", Value}| Attributes], Cookie) -> + ExpireTime = cookie_expires(list_to_integer(Value)), + cookie_attributes(Attributes, + Cookie#http_cookie{max_age = ExpireTime}); +%% Backwards compatibility with netscape cookies +cookie_attributes([{"expires", Value}| Attributes], Cookie) -> + Time = http_util:convert_netscapecookie_date(Value), + ExpireTime = calendar:datetime_to_gregorian_seconds(Time), + cookie_attributes(Attributes, + Cookie#http_cookie{max_age = ExpireTime}); +cookie_attributes([{"path", Value}| Attributes], Cookie) -> + cookie_attributes(Attributes, + Cookie#http_cookie{path = Value}); +cookie_attributes([{"secure", _}| Attributes], Cookie) -> + cookie_attributes(Attributes, + Cookie#http_cookie{secure = true}); +cookie_attributes([{"version", Value}| Attributes], Cookie) -> + cookie_attributes(Attributes, + Cookie#http_cookie{version = Value}); +%% Disregard unknown attributes. +cookie_attributes([_| Attributes], Cookie) -> + cookie_attributes(Attributes, Cookie). + +domain_default(Cookie = #http_cookie{domain = undefined}, + DefaultDomain) -> + Cookie#http_cookie{domain = DefaultDomain, domain_default = true}; +domain_default(Cookie, _) -> + Cookie. + +path_default(Cookie = #http_cookie{path = undefined}, + DefaultPath) -> + Cookie#http_cookie{path = skip_right_most_slash(DefaultPath), + path_default = true}; +path_default(Cookie, _) -> + Cookie. + +%% Note: if the path is only / that / will be keept +skip_right_most_slash("/") -> + "/"; +skip_right_most_slash(Str) -> + string:strip(Str, right, $/). + +accept_cookies(Cookies, RequestPath, RequestHost) -> + lists:filter(fun(Cookie) -> + accept_cookie(Cookie, RequestPath, RequestHost) + end, Cookies). + +accept_cookie(Cookie, RequestPath, RequestHost) -> + accept_path(Cookie, RequestPath) and accept_domain(Cookie, RequestHost). + +accept_path(#http_cookie{path = Path}, RequestPath) -> + lists:prefix(Path, RequestPath). + +accept_domain(#http_cookie{domain = RequestHost}, RequestHost) -> + true; + +accept_domain(#http_cookie{domain = Domain}, RequestHost) -> + HostCheck = case http_util:is_hostname(RequestHost) of + true -> + (lists:suffix(Domain, RequestHost) andalso + (not + lists:member($., + string:substr(RequestHost, 1, + (length(RequestHost) - + length(Domain)))))); + false -> + false + end, + HostCheck andalso (hd(Domain) == $.) + andalso (length(string:tokens(Domain, ".")) > 1). + +cookie_expires(0) -> + 0; +cookie_expires(DeltaSec) -> + NowSec = calendar:datetime_to_gregorian_seconds({date(), time()}), + NowSec + DeltaSec. + +is_cookie_expired(#http_cookie{max_age = session}) -> + false; +is_cookie_expired(#http_cookie{max_age = ExpireTime}) -> + NowSec = calendar:datetime_to_gregorian_seconds({date(), time()}), + ExpireTime - NowSec =< 0. + +valid_cookies([], Valid, _) -> + Valid; + +valid_cookies([Cookie | Cookies], Valid, Db) -> + case is_cookie_expired(Cookie) of + true -> + delete(Cookie, Db), + valid_cookies(Cookies, Valid, Db); + false -> + valid_cookies(Cookies, [Cookie | Valid], Db) + end. + +path_sort(Cookies)-> + lists:reverse(lists:keysort(#http_cookie.path, Cookies)). + + +%% Informally, the Set-Cookie response header comprises the token +%% Set-Cookie:, followed by a comma-separated list of one or more +%% cookies. Netscape cookies expires attribute may also have a +%% , in this case the header list will have been incorrectly split +%% in parse_set_cookies/2 this functions fixs that problem. +fix_netscape_cookie([Cookie1, Cookie2 | Rest], Acc) -> + case inets_regexp:match(Cookie1, "expires=") of + {_, _, _} -> + fix_netscape_cookie(Rest, [Cookie1 ++ Cookie2 | Acc]); + nomatch -> + fix_netscape_cookie([Cookie2 |Rest], [Cookie1| Acc]) + end; +fix_netscape_cookie([Cookie | Rest], Acc) -> + fix_netscape_cookie(Rest, [Cookie | Acc]); + +fix_netscape_cookie([], Acc) -> + Acc. diff --git a/lib/inets/src/http_client/http_uri.erl b/lib/inets/src/http_client/http_uri.erl new file mode 100644 index 0000000000..615a0d8ec4 --- /dev/null +++ b/lib/inets/src/http_client/http_uri.erl @@ -0,0 +1,116 @@ +%% +%% %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(http_uri). + +-export([parse/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +parse(AbsURI) -> + case parse_scheme(AbsURI) of + {error, Reason} -> + {error, Reason}; + {Scheme, Rest} -> + case (catch parse_uri_rest(Scheme, Rest)) of + {UserInfo, Host, Port, Path, Query} -> + {Scheme, UserInfo, Host, Port, Path, Query}; + _ -> + {error, {malformed_url, AbsURI}} + end + end. + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +parse_scheme(AbsURI) -> + case split_uri(AbsURI, ":", {error, no_scheme}, 1, 1) of + {error, no_scheme} -> + {error, no_scheme}; + {StrScheme, Rest} -> + case list_to_atom(http_util:to_lower(StrScheme)) of + Scheme when Scheme == http; Scheme == https -> + {Scheme, Rest}; + Scheme -> + {error, {not_supported_scheme, Scheme}} + end + end. + +parse_uri_rest(Scheme, "//" ++ URIPart) -> + + {Authority, PathQuery} = + case split_uri(URIPart, "/", URIPart, 1, 0) of + Split = {_, _} -> + Split; + URIPart -> + case split_uri(URIPart, "\\?", URIPart, 1, 0) of + Split = {_, _} -> + Split; + URIPart -> + {URIPart,""} + end + end, + + {UserInfo, HostPort} = split_uri(Authority, "@", {"", Authority}, 1, 1), + {Host, Port} = parse_host_port(Scheme, HostPort), + {Path, Query} = parse_path_query(PathQuery), + {UserInfo, Host, Port, Path, Query}. + + +parse_path_query(PathQuery) -> + {Path, Query} = split_uri(PathQuery, "\\?", {PathQuery, ""}, 1, 0), + {path(Path), Query}. + + +parse_host_port(Scheme,"[" ++ HostPort) -> %ipv6 + DefaultPort = default_port(Scheme), + {Host, ColonPort} = split_uri(HostPort, "\\]", {HostPort, ""}, 1, 1), + {_, Port} = split_uri(ColonPort, ":", {"", DefaultPort}, 0, 1), + {Host, int_port(Port)}; + +parse_host_port(Scheme, HostPort) -> + DefaultPort = default_port(Scheme), + {Host, Port} = split_uri(HostPort, ":", {HostPort, DefaultPort}, 1, 1), + {Host, int_port(Port)}. + +split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) -> + case inets_regexp:first_match(UriPart, SplitChar) of + {match, Match, _} -> + {string:substr(UriPart, 1, Match - SkipLeft), + string:substr(UriPart, Match + SkipRight, length(UriPart))}; + nomatch -> + NoMatchResult + end. + +default_port(http) -> + 80; +default_port(https) -> + 443. + +int_port(Port) when is_integer(Port) -> + Port; +int_port(Port) when is_list(Port) -> + list_to_integer(Port). + +path("") -> + "/"; +path(Path) -> + Path. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl new file mode 100644 index 0000000000..7b737c2f86 --- /dev/null +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -0,0 +1,1499 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-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(httpc_handler). + +-behaviour(gen_server). + +-include("httpc_internal.hrl"). +-include("http_internal.hrl"). + + +%%-------------------------------------------------------------------- +%% Internal Application API +-export([start_link/3, send/2, cancel/2, stream/3, stream_next/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-record(timers, + { + request_timers = [], % [ref()] + queue_timer % ref() + }). + +-record(state, + { + request, % #request{} + session, % #tcp_session{} + status_line, % {Version, StatusCode, ReasonPharse} + headers, % #http_response_h{} + body, % binary() + mfa, % {Moduel, Function, Args} + pipeline = queue:new(), % queue() + keep_alive = queue:new(), % queue() + status = new, % new | pipeline | keep_alive | close | ssl_tunnel + canceled = [], % [RequestId] + max_header_size = nolimit, % nolimit | integer() + max_body_size = nolimit, % nolimit | integer() + options, % #options{} + timers = #timers{}, % #timers{} + profile_name, % atom() - id of httpc_manager process. + once % send | undefined + }). + + +%%==================================================================== +%% External functions +%%==================================================================== +%%-------------------------------------------------------------------- +%% Function: start_link(Request, Options, ProfileName) -> {ok, Pid} +%% +%% Request = #request{} +%% Options = #options{} +%% ProfileName = atom() - id of httpc manager process +%% +%% Description: Starts a http-request handler process. Intended to be +%% called by the httpc profile supervisor or the http manager process +%% if the client is started stand alone form inets. +%% +%% Note: Uses proc_lib and gen_server:enter_loop so that waiting +%% for gen_tcp:connect to timeout in init/1 will not +%% block the httpc manager process in odd cases such as trying to call +%% a server that does not exist. (See OTP-6735) The only API function +%% sending messages to the handler process that can be called before +%% init has compleated is cancel and that is not a problem! (Send and +%% stream will not be called before the first request has been sent and +%% the reply or part of it has arrived.) +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +start_link(Request, Options, ProfileName) -> + {ok, proc_lib:spawn_link(?MODULE, init, [[Request, Options, + ProfileName]])}. + + +%%-------------------------------------------------------------------- +%% Function: send(Request, Pid) -> ok +%% Request = #request{} +%% Pid = pid() - the pid of the http-request handler process. +%% +%% Description: Uses this handlers session to send a request. Intended +%% to be called by the httpc manager process. +%%-------------------------------------------------------------------- +send(Request, Pid) -> + call(Request, Pid, 5000). + + +%%-------------------------------------------------------------------- +%% Function: cancel(RequestId, Pid) -> ok +%% RequestId = ref() +%% Pid = pid() - the pid of the http-request handler process. +%% +%% Description: Cancels a request. Intended to be called by the httpc +%% manager process. +%%-------------------------------------------------------------------- +cancel(RequestId, Pid) -> + cast({cancel, RequestId}, Pid). + + +%%-------------------------------------------------------------------- +%% Function: stream_next(Pid) -> ok +%% Pid = pid() - the pid of the http-request handler process. +%% +%% Description: Works as inets:setopts(active, once) but for +%% body chunks sent to the user. +%%-------------------------------------------------------------------- +stream_next(Pid) -> + cast(stream_next, Pid). + + +%%-------------------------------------------------------------------- +%% Function: stream(BodyPart, Request, Code) -> _ +%% BodyPart = binary() +%% Request = #request{} +%% Code = integer() +%% +%% Description: Stream the HTTP body to the caller process (client) +%% or to a file. Note that the data that has been stream +%% does not have to be saved. (We do not want to use up +%% memory in vain.) +%%-------------------------------------------------------------------- +%% Request should not be streamed +stream(BodyPart, Request = #request{stream = none}, _) -> + ?hcrt("stream - none", [{body_part, BodyPart}]), + {BodyPart, Request}; + +%% Stream to caller +stream(BodyPart, Request = #request{stream = Self}, Code) + when ((Code =:= 200) orelse (Code =:= 206)) andalso + ((Self =:= self) orelse (Self =:= {self, once})) -> + ?hcrt("stream - self", [{stream, Self}, {code, Code}, {body_part, BodyPart}]), + httpc_response:send(Request#request.from, + {Request#request.id, stream, BodyPart}), + {<<>>, Request}; + +stream(BodyPart, Request = #request{stream = Self}, 404) + when (Self =:= self) orelse (Self =:= {self, once}) -> + ?hcrt("stream - self with 404", [{stream, Self}, {body_part, BodyPart}]), + httpc_response:send(Request#request.from, + {Request#request.id, stream, BodyPart}), + {<<>>, Request}; + +%% Stream to file +%% This has been moved to start_stream/3 +%% We keep this for backward compatibillity... +stream(BodyPart, Request = #request{stream = Filename}, Code) + when ((Code =:= 200) orelse (Code =:= 206)) andalso is_list(Filename) -> + ?hcrt("stream - filename", [{stream, Filename}, {code, Code}, {body_part, BodyPart}]), + case file:open(Filename, [write, raw, append, delayed_write]) of + {ok, Fd} -> + ?hcrt("stream - file open ok", [{fd, Fd}]), + stream(BodyPart, Request#request{stream = Fd}, 200); + {error, Reason} -> + exit({stream_to_file_failed, Reason}) + end; + +%% Stream to file +stream(BodyPart, Request = #request{stream = Fd}, Code) + when ((Code =:= 200) orelse (Code =:= 206)) -> + ?hcrt("stream to file", [{stream, Fd}, {code, Code}, {body_part, BodyPart}]), + case file:write(Fd, BodyPart) of + ok -> + {<<>>, Request}; + {error, Reason} -> + exit({stream_to_file_failed, Reason}) + end; + +stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed + ?hcrt("stream - ignore", [{request, Request}, {body_part, BodyPart}]), + {BodyPart, Request}. + + +%%==================================================================== +%% Server functions +%%==================================================================== + +%%-------------------------------------------------------------------- +%% Function: init([Request, Options, ProfileName]) -> {ok, State} | +%% {ok, State, Timeout} | ignore |{stop, Reason} +%% +%% Request = #request{} +%% Options = #options{} +%% ProfileName = atom() - id of httpc manager process +%% +%% Description: Initiates the httpc_handler process +%% +%% Note: The init function may not fail, that will kill the +%% httpc_manager process. We could make the httpc_manager more comlex +%% but we do not want that so errors will be handled by the process +%% sending an init_error message to itself. +%%-------------------------------------------------------------------- +init([Request, Options, ProfileName]) -> + process_flag(trap_exit, true), + + handle_verbose(Options#options.verbose), + Address = handle_proxy(Request#request.address, Options#options.proxy), + {ok, State} = + case {Address /= Request#request.address, Request#request.scheme} of + {true, https} -> + Error = https_through_proxy_is_not_currently_supported, + self() ! {init_error, + Error, httpc_response:error(Request, Error)}, + {ok, #state{request = Request, options = Options, + status = ssl_tunnel}}; + %% This is what we should do if and when ssl supports + %% "socket upgrading" + %%send_ssl_tunnel_request(Address, Request, + %% #state{options = Options, + %% status = ssl_tunnel}); + {_, _} -> + send_first_request(Address, Request, + #state{options = Options, + profile_name = ProfileName}) + end, + gen_server:enter_loop(?MODULE, [], State). + +%%-------------------------------------------------------------------- +%% Function: handle_call(Request, From, State) -> {reply, Reply, State} | +%% {reply, Reply, State, Timeout} | +%% {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, Reply, State} | (terminate/2 is called) +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling call messages +%%-------------------------------------------------------------------- +handle_call(Request, _, State = #state{session = Session = + #tcp_session{socket = Socket, + type = pipeline}, + timers = Timers, + options = Options, + profile_name = ProfileName}) -> + Address = handle_proxy(Request#request.address, Options#options.proxy), + + case httpc_request:send(Address, Request, Socket) of + ok -> + %% Activate the request time out for the new request + NewState = activate_request_timeout(State#state{request = + Request}), + + ClientClose = httpc_request:is_client_closing( + Request#request.headers), + case State#state.request of + #request{} -> %% Old request no yet finished + %% Make sure to use the new value of timers in state + NewTimers = NewState#state.timers, + NewPipeline = queue:in(Request, State#state.pipeline), + NewSession = + Session#tcp_session{queue_length = + %% Queue + current + queue:len(NewPipeline) + 1, + client_close = ClientClose}, + httpc_manager:insert_session(NewSession, ProfileName), + {reply, ok, State#state{pipeline = NewPipeline, + session = NewSession, + timers = NewTimers}}; + undefined -> + %% Note: tcp-message reciving has already been + %% activated by handle_pipeline/2. + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + NewSession = + Session#tcp_session{queue_length = 1, + client_close = ClientClose}, + httpc_manager:insert_session(NewSession, ProfileName), + Relaxed = + (Request#request.settings)#http_options.relaxed, + {reply, ok, + NewState#state{request = Request, + session = NewSession, + mfa = {httpc_response, parse, + [State#state.max_header_size, + Relaxed]}, + timers = + Timers#timers{queue_timer = + undefined}}} + end; + {error, Reason} -> + {reply, {pipeline_failed, Reason}, State} + end; + +handle_call(Request, _, #state{session = Session = + #tcp_session{type = keep_alive, + socket = Socket}, + timers = Timers, + options = Options, + profile_name = ProfileName} = State) -> + + ClientClose = httpc_request:is_client_closing(Request#request.headers), + + Address = handle_proxy(Request#request.address, + Options#options.proxy), + case httpc_request:send(Address, Request, Socket) of + ok -> + NewState = + activate_request_timeout(State#state{request = + Request}), + + case State#state.request of + #request{} -> %% Old request not yet finished + %% Make sure to use the new value of timers in state + NewTimers = NewState#state.timers, + NewKeepAlive = queue:in(Request, State#state.keep_alive), + NewSession = + Session#tcp_session{queue_length = + %% Queue + current + queue:len(NewKeepAlive) + 1, + client_close = ClientClose}, + httpc_manager:insert_session(NewSession, ProfileName), + {reply, ok, State#state{keep_alive = NewKeepAlive, + session = NewSession, + timers = NewTimers}}; + undefined -> + %% Note: tcp-message reciving has already been + %% activated by handle_pipeline/2. + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + NewSession = + Session#tcp_session{queue_length = 1, + client_close = ClientClose}, + httpc_manager:insert_session(NewSession, ProfileName), + Relaxed = + (Request#request.settings)#http_options.relaxed, + {reply, ok, + NewState#state{request = Request, + session = NewSession, + mfa = {httpc_response, parse, + [State#state.max_header_size, + Relaxed]}}} + end; + {error, Reason} -> + {reply, {request_failed, Reason}, State} + end. + +%%-------------------------------------------------------------------- +%% Function: handle_cast(Msg, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling cast messages +%%-------------------------------------------------------------------- + +%% When the request in process has been canceled the handler process is +%% stopped and the pipelined requests will be reissued or remaining +%% requests will be sent on a new connection. This is is +%% based on the assumption that it is proably cheaper to reissue the +%% requests than to wait for a potentiall large response that we then +%% only throw away. This of course is not always true maybe we could +%% do something smarter here?! If the request canceled is not +%% the one handled right now the same effect will take place in +%% handle_pipeline/2 when the canceled request is on turn, +%% handle_keep_alive_queue/2 on the other hand will just skip the +%% request as if it was never issued as in this case the request will +%% not have been sent. +handle_cast({cancel, RequestId}, State = #state{request = Request = + #request{id = RequestId}, + profile_name = ProfileName}) -> + httpc_manager:request_canceled(RequestId, ProfileName), + {stop, normal, + State#state{canceled = [RequestId | State#state.canceled], + request = Request#request{from = answer_sent}}}; +handle_cast({cancel, RequestId}, State = #state{profile_name = ProfileName}) -> + httpc_manager:request_canceled(RequestId, ProfileName), + {noreply, State#state{canceled = [RequestId | State#state.canceled]}}; +handle_cast(stream_next, #state{session = Session} = State) -> + http_transport:setopts(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, [{active, once}]), + {noreply, State#state{once = once}}. + + +%%-------------------------------------------------------------------- +%% Function: handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling all non call/cast messages +%%-------------------------------------------------------------------- +handle_info({Proto, _Socket, Data}, + #state{mfa = {Module, Function, Args} = MFA, + request = #request{method = Method, + stream = Stream} = Request, + session = Session, + status_line = StatusLine} = State) + when (Proto =:= tcp) orelse + (Proto =:= ssl) orelse + (Proto =:= httpc_handler) -> + + ?hcri("received data", [{proto, Proto}, {data, Data}, {mfa, MFA}, {method, Method}, {stream, Stream}, {session, Session}, {status_line, StatusLine}]), + + FinalResult = + try Module:Function([Data | Args]) of + {ok, Result} -> + ?hcrd("data processed - ok", [{result, Result}]), + handle_http_msg(Result, State); + {_, whole_body, _} when Method =:= head -> + ?hcrd("data processed - whole body", []), + handle_response(State#state{body = <<>>}); + {Module, whole_body, [Body, Length]} -> + ?hcrd("data processed - whole body", [{module, Module}, {body, Body}, {length, Length}]), + {_, Code, _} = StatusLine, + {NewBody, NewRequest} = stream(Body, Request, Code), + %% When we stream we will not keep the already + %% streamed data, that would be a waste of memory. + NewLength = case Stream of + none -> + Length; + _ -> + Length - size(Body) + end, + + NewState = next_body_chunk(State), + + {noreply, NewState#state{mfa = {Module, whole_body, + [NewBody, NewLength]}, + request = NewRequest}}; + NewMFA -> + ?hcrd("data processed", [{new_mfa, NewMFA}]), + http_transport:setopts(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + [{active, once}]), + {noreply, State#state{mfa = NewMFA}} + catch + exit:_ -> + ClientErrMsg = httpc_response:error(Request, + {could_not_parse_as_http, + Data}), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState}; + error:_ -> + ClientErrMsg = httpc_response:error(Request, + {could_not_parse_as_http, + Data}), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState} + + end, + ?hcri("data processed", [{result, FinalResult}]), + FinalResult; + + +handle_info({Proto, Socket, Data}, + #state{mfa = MFA, + request = Request, + session = Session, + status = Status, + status_line = StatusLine, + profile_name = Profile} = State) + when (Proto =:= tcp) orelse + (Proto =:= ssl) orelse + (Proto =:= httpc_handler) -> + + error_logger:warning_msg("Received unexpected ~p data on ~p" + "~n Data: ~p" + "~n MFA: ~p" + "~n Request: ~p" + "~n Session: ~p" + "~n Status: ~p" + "~n StatusLine: ~p" + "~n Profile: ~p" + "~n", + [Proto, Socket, Data, MFA, + Request, Session, Status, StatusLine, Profile]), + {noreply, State}; + + +%% The Server may close the connection to indicate that the +%% whole body is now sent instead of sending an length +%% indicator. +handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> + handle_response(State#state{body = hd(Args)}); +handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> + handle_response(State#state{body = hd(Args)}); + +%%% Server closes idle pipeline +handle_info({tcp_closed, _}, State = #state{request = undefined}) -> + {stop, normal, State}; +handle_info({ssl_closed, _}, State = #state{request = undefined}) -> + {stop, normal, State}; + +%%% Error cases +handle_info({tcp_closed, _}, #state{session = Session0} = State) -> + Socket = Session0#tcp_session.socket, + Session = Session0#tcp_session{socket = {remote_close, Socket}}, + %% {stop, session_remotly_closed, State}; + {stop, normal, State#state{session = Session}}; +handle_info({ssl_closed, _}, #state{session = Session0} = State) -> + Socket = Session0#tcp_session.socket, + Session = Session0#tcp_session{socket = {remote_close, Socket}}, + %% {stop, session_remotly_closed, State}; + {stop, normal, State#state{session = Session}}; +handle_info({tcp_error, _, _} = Reason, State) -> + {stop, Reason, State}; +handle_info({ssl_error, _, _} = Reason, State) -> + {stop, Reason, State}; + +%% Timeouts +%% Internally, to a request handling process, a request timeout is +%% seen as a canceled request. +handle_info({timeout, RequestId}, + #state{request = #request{id = RequestId} = Request, + canceled = Canceled} = State) -> + httpc_response:send(Request#request.from, + httpc_response:error(Request,timeout)), + {stop, normal, + State#state{request = Request#request{from = answer_sent}, + canceled = [RequestId | Canceled]}}; + +handle_info({timeout, RequestId}, #state{canceled = Canceled} = State) -> + Filter = + fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> + %% Notify the owner + Response = httpc_response:error(Request, timeout), + httpc_response:send(From, Response), + [Request#request{from = answer_sent}]; + (_) -> + true + end, + case State#state.status of + pipeline -> + Pipeline = queue:filter(Filter, State#state.pipeline), + {noreply, State#state{canceled = [RequestId | Canceled], + pipeline = Pipeline}}; + keep_alive -> + KeepAlive = queue:filter(Filter, State#state.keep_alive), + {noreply, State#state{canceled = [RequestId | Canceled], + keep_alive = KeepAlive}} + end; + +handle_info(timeout_queue, State = #state{request = undefined}) -> + {stop, normal, State}; + +%% Timing was such as the pipeline_timout was not canceled! +handle_info(timeout_queue, #state{timers = Timers} = State) -> + {noreply, State#state{timers = + Timers#timers{queue_timer = undefined}}}; + +%% Setting up the connection to the server somehow failed. +handle_info({init_error, _, ClientErrMsg}, + State = #state{request = Request}) -> + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState}; + + +%%% httpc_manager process dies. +handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> + {stop, normal, State}; +%%Try to finish the current request anyway, +%% there is a fairly high probability that it can be done successfully. +%% Then close the connection, hopefully a new manager is started that +%% can retry requests in the pipeline. +handle_info({'EXIT', _, _}, State) -> + {noreply, State#state{status = close}}. + + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> _ (ignored by gen_server) +%% Description: Shutdown the httpc_handler +%%-------------------------------------------------------------------- + +%% Init error there is no socket to be closed. +terminate(normal, #state{session = undefined}) -> + ok; + +%% Init error sending, no session information has been setup but +%% there is a socket that needs closing. +terminate(normal, #state{request = Request, + session = #tcp_session{id = undefined, + socket = Socket}}) -> + http_transport:close(socket_type(Request), Socket); + +%% Socket closed remotely +terminate(normal, + #state{session = #tcp_session{socket = {remote_close, Socket}, + id = Id}, + profile_name = ProfileName, + request = Request, + timers = Timers, + pipeline = Pipeline}) -> + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + %% Cancel timers + #timers{request_timers = ReqTmrs, queue_timer = QTmr} = Timers, + cancel_timer(QTmr, timeout_queue), + lists:foreach(fun({_, Timer}) -> cancel_timer(Timer, timeout) end, + ReqTmrs), + + %% Maybe deliver answers to requests + deliver_answers([Request | queue:to_list(Pipeline)]), + + %% And, just in case, close our side (**really** overkill) + http_transport:close(socket_type(Request), Socket); + +terminate(_, State = #state{session = Session, + request = undefined, + profile_name = ProfileName, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive}) -> + catch httpc_manager:delete_session(Session#tcp_session.id, + ProfileName), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + cancel_timer(Timers#timers.queue_timer, timeout_queue), + Socket = Session#tcp_session.socket, + http_transport:close(socket_type(Session#tcp_session.scheme), Socket); + +terminate(Reason, State = #state{request = Request}) -> + NewState = maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + terminate(Reason, NewState#state{request = undefined}). + +maybe_retry_queue(Q, State) -> + case queue:is_empty(Q) of + false -> + retry_pipeline(queue:to_list(Q), State); + true -> + ok + end. + +maybe_send_answer(#request{from = answer_sent}, _Reason, State) -> + State; +maybe_send_answer(Request, Answer, State) -> + answer_request(Request, Answer, State). + +deliver_answers([]) -> + ok; +deliver_answers([#request{from = From} = Request | Requests]) + when is_pid(From) -> + Response = httpc_response:error(Request, socket_closed_remotely), + httpc_response:send(From, Response), + deliver_answers(Requests); +deliver_answers([_|Requests]) -> + deliver_answers(Requests). + + +%%-------------------------------------------------------------------- +%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} +%% Purpose: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_, #state{request = Request, pipeline = Queue} = State, + [{from, '5.0.1'}, {to, '5.0.2'}]) -> + Settings = new_http_options(Request#request.settings), + NewRequest = Request#request{settings = Settings}, + NewQueue = new_queue(Queue, fun new_http_options/1), + {ok, State#state{request = NewRequest, pipeline = NewQueue}}; + +code_change(_, #state{request = Request, pipeline = Queue} = State, + [{from, '5.0.2'}, {to, '5.0.1'}]) -> + Settings = old_http_options(Request#request.settings), + NewRequest = Request#request{settings = Settings}, + NewQueue = new_queue(Queue, fun old_http_options/1), + {ok, State#state{request = NewRequest, pipeline = NewQueue}}; + +code_change(_, State, _) -> + {ok, State}. + +new_http_options({http_options, TimeOut, AutoRedirect, SslOpts, + Auth, Relaxed}) -> + {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts, + Auth, Relaxed}. + +old_http_options({http_options, _, TimeOut, AutoRedirect, + SslOpts, Auth, Relaxed}) -> + {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}. + +new_queue(Queue, Fun) -> + List = queue:to_list(Queue), + NewList = + lists:map(fun(Request) -> + Settings = + Fun(Request#request.settings), + Request#request{settings = Settings} + end, List), + queue:from_list(NewList). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +connect(SocketType, ToAddress, #options{ipfamily = IpFamily, + ip = FromAddress, + port = FromPort}, Timeout) -> + Opts1 = + case FromPort of + default -> + []; + _ -> + [{port, FromPort}] + end, + Opts2 = + case FromAddress of + default -> + Opts1; + _ -> + [{ip, FromAddress} | Opts1] + end, + case IpFamily of + inet6fb4 -> + Opts3 = [inet6 | Opts2], + case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of + {error, Reason} when ((Reason =:= nxdomain) orelse + (Reason =:= eafnosupport)) -> + Opts4 = [inet | Opts2], + http_transport:connect(SocketType, ToAddress, Opts4, Timeout); + Other -> + Other + end; + _ -> + Opts3 = [IpFamily | Opts2], + http_transport:connect(SocketType, ToAddress, Opts3, Timeout) + end. + + +send_first_request(Address, Request, #state{options = Options} = State) -> + SocketType = socket_type(Request), + ConnTimeout = (Request#request.settings)#http_options.connect_timeout, + ?hcri("connect", + [{address, Address}, {request, Request}, {options, Options}]), + case connect(SocketType, Address, Options, ConnTimeout) of + {ok, Socket} -> + ?hcri("connected - now send first request", [{socket, Socket}]), + case httpc_request:send(Address, Request, Socket) of + ok -> + ?hcri("first request sent", []), + ClientClose = + httpc_request:is_client_closing( + Request#request.headers), + SessionType = httpc_manager:session_type(Options), + Session = + #tcp_session{id = {Request#request.address, self()}, + scheme = Request#request.scheme, + socket = Socket, + client_close = ClientClose, + type = SessionType}, + TmpState = State#state{request = Request, + session = Session, + mfa = init_mfa(Request, State), + status_line = + init_status_line(Request), + headers = undefined, + body = undefined, + status = new}, + http_transport:setopts(SocketType, + Socket, [{active, once}]), + NewState = activate_request_timeout(TmpState), + {ok, NewState}; + + {error, Reason} -> + %% Commented out in wait of ssl support to avoid + %% dialyzer warning + %%case State#state.status of + %% new -> % Called from init/1 + self() ! {init_error, error_sending, + httpc_response:error(Request, Reason)}, + {ok, State#state{request = Request, + session = + #tcp_session{socket = Socket}}} + %%ssl_tunnel -> % Not called from init/1 + %% NewState = + %% answer_request(Request, + %%httpc_response:error(Request, + %%Reason), + %% State), + %% {stop, normal, NewState} + %% end + end; + + {error, Reason} -> + %% Commented out in wait of ssl support to avoid + %% dialyzer warning + %% case State#state.status of + %% new -> % Called from init/1 + self() ! {init_error, error_connecting, + httpc_response:error(Request, Reason)}, + {ok, State#state{request = Request}} + %% ssl_tunnel -> % Not called from init/1 + %% NewState = + %% answer_request(Request, + %% httpc_response:error(Request, + %% Reason), + %% State), + %% {stop, normal, NewState} + %%end + end. + +handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, + State = #state{request = Request}) -> + ?hcrt("handle_http_msg", [{body, Body}]), + case Headers#http_response_h.'content-type' of + "multipart/byteranges" ++ _Param -> + exit(not_yet_implemented); + _ -> + StatusLine = {Version, StatusCode, ReasonPharse}, + {ok, NewRequest} = start_stream(StatusLine, Headers, Request), + handle_http_body(Body, + State#state{request = NewRequest, + status_line = StatusLine, + headers = Headers}) + end; +handle_http_msg({ChunkedHeaders, Body}, + State = #state{headers = Headers}) -> + ?hcrt("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 = #state{status_line = {_,Code, _}}) -> + ?hcrt("handle_http_msg", [{body, Body}, {code, Code}]), + {NewBody, NewRequest}= stream(Body, State#state.request, Code), + handle_response(State#state{body = NewBody, request = NewRequest}). + +handle_http_body(<<>>, State = #state{status_line = {_,304, _}}) -> + ?hcrt("handle_http_body - 304", []), + handle_response(State#state{body = <<>>}); + +handle_http_body(<<>>, State = #state{status_line = {_,204, _}}) -> + ?hcrt("handle_http_body - 204", []), + handle_response(State#state{body = <<>>}); + +handle_http_body(<<>>, State = #state{request = #request{method = head}}) -> + ?hcrt("handle_http_body - head", []), + handle_response(State#state{body = <<>>}); + +handle_http_body(Body, State = #state{headers = Headers, + max_body_size = MaxBodySize, + status_line = {_,Code, _}, + request = Request}) -> + ?hcrt("handle_http_body", [{body, Body}, {max_body_size, MaxBodySize}, {code, Code}]), + TransferEnc = Headers#http_response_h.'transfer-encoding', + case case_insensitive_header(TransferEnc) of + "chunked" -> + ?hcrt("handle_http_body - chunked", []), + case http_chunk:decode(Body, State#state.max_body_size, + State#state.max_header_size, + {Code, Request}) of + {Module, Function, Args} -> + ?hcrt("handle_http_body - new mfa", [{module, Module}, {function, Function}, {args, Args}]), + NewState = next_body_chunk(State), + {noreply, NewState#state{mfa = + {Module, Function, Args}}}; + {ok, {ChunkedHeaders, NewBody}} -> + ?hcrt("handle_http_body - nyew body", [{chunked_headers, ChunkedHeaders}, {new_body, NewBody}]), + NewHeaders = http_chunk:handle_headers(Headers, + ChunkedHeaders), + handle_response(State#state{headers = NewHeaders, + body = NewBody}) + end; + Encoding when is_list(Encoding) -> + ?hcrt("handle_http_body - encoding", [{encoding, Encoding}]), + NewState = answer_request(Request, + httpc_response:error(Request, + unknown_encoding), + State), + {stop, normal, NewState}; + _ -> + ?hcrt("handle_http_body - other", []), + Length = + list_to_integer(Headers#http_response_h.'content-length'), + case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of + true -> + case httpc_response:whole_body(Body, Length) of + {ok, Body} -> + {NewBody, NewRequest}= stream(Body, Request, Code), + handle_response(State#state{body = NewBody, + request = NewRequest}); + MFA -> + NewState = next_body_chunk(State), + {noreply, NewState#state{mfa = MFA}} + end; + false -> + NewState = + answer_request(Request, + httpc_response:error(Request, + body_too_big), + State), + {stop, normal, NewState} + end + end. + +%%% Normaly I do not comment out code, I throw it away. But this might +%%% actually be used on day if ssl is improved. +%% handle_response(State = #state{status = ssl_tunnel, +%% request = Request, +%% options = Options, +%% session = #tcp_session{socket = Socket, +%% scheme = Scheme}, +%% status_line = {_, 200, _}}) -> +%% %%% Insert code for upgrading the socket if and when ssl supports this. +%% Address = handle_proxy(Request#request.address, Options#options.proxy), +%% send_first_request(Address, Request, State); +%% handle_response(State = #state{status = ssl_tunnel, +%% request = Request}) -> +%% NewState = answer_request(Request, +%% httpc_response:error(Request, +%% ssl_proxy_tunnel_failed), +%% State), +%% {stop, normal, NewState}; + +handle_response(State = #state{status = new}) -> + handle_response(try_to_enable_pipeline_or_keep_alive(State)); + +handle_response(State = + #state{request = Request, + status = Status, + session = Session, + status_line = StatusLine, + headers = Headers, + body = Body, + options = Options, + profile_name = ProfileName}) when Status =/= new -> + ?hcrt("handle response", [{status, Status}, {session, Session}, {status_line, StatusLine}, {profile_name, ProfileName}]), + handle_cookies(Headers, Request, Options, ProfileName), + case httpc_response:result({StatusLine, Headers, Body}, Request) of + %% 100-continue + continue -> + %% Send request body + {_, RequestBody} = Request#request.content, + http_transport:send(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + RequestBody), + %% Wait for next response + http_transport:setopts(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + [{active, once}]), + Relaxed = (Request#request.settings)#http_options.relaxed, + {noreply, + State#state{mfa = {httpc_response, parse, + [State#state.max_header_size, + Relaxed]}, + status_line = undefined, + headers = undefined, + body = undefined + }}; + %% Ignore unexpected 100-continue response and receive the + %% actual response that the server will send right away. + {ignore, Data} -> + Relaxed = (Request#request.settings)#http_options.relaxed, + NewState = State#state{mfa = + {httpc_response, parse, + [State#state.max_header_size, + Relaxed]}, + status_line = undefined, + headers = undefined, + body = undefined}, + handle_info({httpc_handler, dummy, Data}, NewState); + %% On a redirect or retry the current request becomes + %% obsolete and the manager will create a new request + %% with the same id as the current. + {redirect, NewRequest, Data} -> + ?hcrt("handle response - redirect", [{new_request, NewRequest}, {data, Data}]), + ok = httpc_manager:redirect_request(NewRequest, ProfileName), + handle_queue(State#state{request = undefined}, Data); + {retry, TimeNewRequest, Data} -> + ?hcrt("handle response - retry", [{time_new_request, TimeNewRequest}, {data, Data}]), + ok = httpc_manager:retry_request(TimeNewRequest, ProfileName), + handle_queue(State#state{request = undefined}, Data); + {ok, Msg, Data} -> + ?hcrt("handle response - result ok", [{msg, Msg}, {data, Data}]), + end_stream(StatusLine, Request), + NewState = answer_request(Request, Msg, State), + handle_queue(NewState, Data); + {stop, Msg} -> + ?hcrt("handle response - result stop", [{msg, Msg}]), + end_stream(StatusLine, Request), + NewState = answer_request(Request, Msg, State), + {stop, normal, NewState} + end. + +handle_cookies(_,_, #options{cookies = disabled}, _) -> + ok; +%% User wants to verify the cookies before they are stored, +%% so the user will have to call a store command. +handle_cookies(_,_, #options{cookies = verify}, _) -> + ok; +handle_cookies(Headers, Request, #options{cookies = enabled}, ProfileName) -> + {Host, _ } = Request#request.address, + Cookies = http_cookie:cookies(Headers#http_response_h.other, + Request#request.path, Host), + httpc_manager:store_cookies(Cookies, Request#request.address, + ProfileName). + +%% This request could not be pipelined or used as sequential keept alive +%% queue +handle_queue(State = #state{status = close}, _) -> + {stop, normal, State}; + +handle_queue(State = #state{status = keep_alive}, Data) -> + handle_keep_alive_queue(State, Data); + +handle_queue(State = #state{status = pipeline}, Data) -> + handle_pipeline(State, Data). + +handle_pipeline(State = + #state{status = pipeline, session = Session, + profile_name = ProfileName, + options = #options{pipeline_timeout = TimeOut}}, + Data) -> + case queue:out(State#state.pipeline) of + {empty, _} -> + %% The server may choose too teminate an idle pipeline + %% in this case we want to receive the close message + %% at once and not when trying to pipeline the next + %% request. + http_transport:setopts(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + [{active, once}]), + %% If a pipeline that has been idle for some time is not + %% closed by the server, the client may want to close it. + NewState = activate_queue_timeout(TimeOut, State), + NewSession = Session#tcp_session{queue_length = 0}, + httpc_manager:insert_session(NewSession, ProfileName), + %% Note mfa will be initilized when a new request + %% arrives. + {noreply, + NewState#state{request = undefined, + mfa = undefined, + status_line = undefined, + headers = undefined, + body = undefined + } + }; + {{value, NextRequest}, Pipeline} -> + case lists:member(NextRequest#request.id, + State#state.canceled) of + true -> + %% See comment for handle_cast({cancel, RequestId}) + {stop, normal, + State#state{request = + NextRequest#request{from = answer_sent}}}; + false -> + NewSession = + Session#tcp_session{queue_length = + %% Queue + current + queue:len(Pipeline) + 1}, + httpc_manager:insert_session(NewSession, ProfileName), + Relaxed = + (NextRequest#request.settings)#http_options.relaxed, + NewState = + State#state{pipeline = Pipeline, + request = NextRequest, + mfa = {httpc_response, parse, + [State#state.max_header_size, + Relaxed]}, + status_line = undefined, + headers = undefined, + body = undefined}, + case Data of + <<>> -> + http_transport:setopts( + socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + [{active, once}]), + {noreply, NewState}; + _ -> + %% If we already received some bytes of + %% the next response + handle_info({httpc_handler, dummy, Data}, + NewState) + end + end + end. + +handle_keep_alive_queue(State = #state{status = keep_alive, + session = Session, + profile_name = ProfileName, + options = #options{keep_alive_timeout + = TimeOut} + }, + Data) -> + case queue:out(State#state.keep_alive) of + {empty, _} -> + %% The server may choose too terminate an idle keep_alive session + %% in this case we want to receive the close message + %% at once and not when trying to send the next + %% request. + http_transport:setopts(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + [{active, once}]), + %% If a keep_alive session has been idle for some time is not + %% closed by the server, the client may want to close it. + NewState = activate_queue_timeout(TimeOut, State), + NewSession = Session#tcp_session{queue_length = 0}, + httpc_manager:insert_session(NewSession, ProfileName), + %% Note mfa will be initilized when a new request + %% arrives. + {noreply, + NewState#state{request = undefined, + mfa = undefined, + status_line = undefined, + headers = undefined, + body = undefined + } + }; + {{value, NextRequest}, KeepAlive} -> + case lists:member(NextRequest#request.id, + State#state.canceled) of + true -> + handle_keep_alive_queue(State#state{keep_alive = + KeepAlive}, Data); + false -> + Relaxed = + (NextRequest#request.settings)#http_options.relaxed, + NewState = + State#state{request = NextRequest, + keep_alive = KeepAlive, + mfa = {httpc_response, parse, + [State#state.max_header_size, + Relaxed]}, + status_line = undefined, + headers = undefined, + body = undefined}, + case Data of + <<>> -> + http_transport:setopts( + socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, [{active, once}]), + {noreply, NewState}; + _ -> + %% If we already received some bytes of + %% the next response + handle_info({httpc_handler, dummy, Data}, + NewState) + end + end + end. + +call(Msg, Pid, Timeout) -> + gen_server:call(Pid, Msg, Timeout). + +cast(Msg, Pid) -> + gen_server:cast(Pid, Msg). + +case_insensitive_header(Str) when is_list(Str) -> + http_util:to_lower(Str); +%% Might be undefined if server does not send such a header +case_insensitive_header(Str) -> + Str. + +activate_request_timeout(State = #state{request = Request}) -> + Time = (Request#request.settings)#http_options.timeout, + case Time of + infinity -> + State; + _ -> + Ref = erlang:send_after(Time, self(), + {timeout, Request#request.id}), + State#state + {timers = + #timers{request_timers = + [{Request#request.id, Ref}| + (State#state.timers)#timers.request_timers]}} + end. + +activate_queue_timeout(infinity, State) -> + State; +activate_queue_timeout(Time, State) -> + Ref = erlang:send_after(Time, self(), timeout_queue), + State#state{timers = #timers{queue_timer = Ref}}. + + +is_pipeline_enabled_client(#tcp_session{type = pipeline}) -> + true; +is_pipeline_enabled_client(_) -> + false. + +is_keep_alive_enabled_server("HTTP/1." ++ N, _) when (hd(N) >= $1) -> + true; +is_keep_alive_enabled_server("HTTP/1.0", + #http_response_h{connection = "keep-alive"}) -> + true; +is_keep_alive_enabled_server(_,_) -> + false. + +is_keep_alive_connection(Headers, Session) -> + (not ((Session#tcp_session.client_close) or + httpc_response:is_server_closing(Headers))). + +try_to_enable_pipeline_or_keep_alive(State = + #state{session = Session, + request = #request{method = Method}, + status_line = {Version, _, _}, + headers = Headers, + profile_name = ProfileName}) -> + case (is_keep_alive_enabled_server(Version, Headers) andalso + is_keep_alive_connection(Headers, Session)) of + true -> + case (is_pipeline_enabled_client(Session) andalso + httpc_request:is_idempotent(Method)) of + true -> + httpc_manager:insert_session(Session, ProfileName), + State#state{status = pipeline}; + false -> + httpc_manager:insert_session(Session, ProfileName), + %% Make sure type is keep_alive in session + %% as it in this case might be pipeline + State#state{status = keep_alive, + session = + Session#tcp_session{type = keep_alive}} + end; + false -> + State#state{status = close} + end. + +answer_request(Request, Msg, #state{timers = Timers} = State) -> + httpc_response:send(Request#request.from, Msg), + RequestTimers = Timers#timers.request_timers, + TimerRef = + proplists:get_value(Request#request.id, RequestTimers, undefined), + Timer = {Request#request.id, TimerRef}, + cancel_timer(TimerRef, {timeout, Request#request.id}), + State#state{request = Request#request{from = answer_sent}, + timers = + Timers#timers{request_timers = + lists:delete(Timer, RequestTimers)}}. +cancel_timer(undefined, _) -> + ok; +cancel_timer(Timer, TimeoutMsg) -> + erlang:cancel_timer(Timer), + receive + TimeoutMsg -> + ok + after 0 -> + ok + end. + +retry_pipeline([], _) -> + ok; + +%% Skip requests when the answer has already been sent +retry_pipeline([#request{from = answer_sent}|PipeLine], State) -> + retry_pipeline(PipeLine, State); + +retry_pipeline([Request | PipeLine], + #state{timers = Timers, + profile_name = ProfileName} = State) -> + NewState = + case (catch httpc_manager:retry_request(Request, ProfileName)) of + ok -> + RequestTimers = Timers#timers.request_timers, + TimerRef = + proplists:get_value(Request#request.id, RequestTimers, + undefined), + cancel_timer(TimerRef, {timeout, Request#request.id}), + State#state{timers = Timers#timers{request_timers = + lists:delete({Request#request.id, + TimerRef}, + RequestTimers)}}; + Error -> + answer_request(Request#request.from, + httpc_response:error(Request, Error), State) + end, + retry_pipeline(PipeLine, NewState). + +%%% Check to see if the given {Host,Port} tuple is in the NoProxyList +%%% Returns an eventually updated {Host,Port} tuple, with the proxy address +handle_proxy(HostPort = {Host, _Port}, {Proxy, NoProxy}) -> + case Proxy of + undefined -> + HostPort; + Proxy -> + case is_no_proxy_dest(Host, NoProxy) of + true -> + HostPort; + false -> + Proxy + end + end. + +is_no_proxy_dest(_, []) -> + false; +is_no_proxy_dest(Host, [ "*." ++ NoProxyDomain | NoProxyDests]) -> + + case is_no_proxy_dest_domain(Host, NoProxyDomain) of + true -> + true; + false -> + is_no_proxy_dest(Host, NoProxyDests) + end; + +is_no_proxy_dest(Host, [NoProxyDest | NoProxyDests]) -> + IsNoProxyDest = case http_util:is_hostname(NoProxyDest) of + true -> + fun is_no_proxy_host_name/2; + false -> + fun is_no_proxy_dest_address/2 + end, + + case IsNoProxyDest(Host, NoProxyDest) of + true -> + true; + false -> + is_no_proxy_dest(Host, NoProxyDests) + end. + +is_no_proxy_host_name(Host, Host) -> + true; +is_no_proxy_host_name(_,_) -> + false. + +is_no_proxy_dest_domain(Dest, DomainPart) -> + lists:suffix(DomainPart, Dest). + +is_no_proxy_dest_address(Dest, Dest) -> + true; +is_no_proxy_dest_address(Dest, AddressPart) -> + lists:prefix(AddressPart, Dest). + +init_mfa(#request{settings = Settings}, State) -> + case Settings#http_options.version of + "HTTP/0.9" -> + {httpc_response, whole_body, [<<>>, -1]}; + _ -> + Relaxed = Settings#http_options.relaxed, + {httpc_response, parse, [State#state.max_header_size, Relaxed]} + end. + +init_status_line(#request{settings = Settings}) -> + case Settings#http_options.version of + "HTTP/0.9" -> + {"HTTP/0.9", 200, "OK"}; + _ -> + undefined + end. + +socket_type(#request{scheme = http}) -> + ip_comm; +socket_type(#request{scheme = https, settings = Settings}) -> + {ssl, Settings#http_options.ssl}; +socket_type(http) -> + ip_comm; +socket_type(https) -> + {ssl, []}. %% Dummy value ok for ex setops that does not use this value + +start_stream({_Version, _Code, _ReasonPhrase}, _Headers, #request{stream = none} = Request) -> + ?hcrt("start stream - none", []), + {ok, Request}; +start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = self} = Request) + when (Code =:= 200) orelse (Code =:= 206) -> + ?hcrt("start stream - self", [{code, Code}]), + Msg = httpc_response:stream_start(Headers, Request, ignore), + httpc_response:send(Request#request.from, Msg), + {ok, Request}; +start_stream({_Version, Code, _ReasonPhrase}, Headers, + #request{stream = {self, once}} = Request) + when (Code =:= 200) orelse (Code =:= 206) -> + ?hcrt("start stream - self:once", [{code, Code}]), + Msg = httpc_response:stream_start(Headers, Request, self()), + httpc_response:send(Request#request.from, Msg), + {ok, Request}; +start_stream({_Version, Code, _ReasonPhrase}, _Headers, #request{stream = Filename} = Request) + when ((Code =:= 200) orelse (Code =:= 206)) andalso is_list(Filename) -> + ?hcrt("start stream", [{code, Code}, {filename, Filename}]), + case file:open(Filename, [write, raw, append, delayed_write]) of + {ok, Fd} -> + ?hcri("start stream - file open ok", [{fd, Fd}]), + {ok, Request#request{stream = Fd}}; + {error, Reason} -> + exit({stream_to_file_failed, Reason}) + end; +start_stream(_StatusLine, _Headers, Request) -> + ?hcrt("start stream - no op", []), + {ok, Request}. + + +%% Note the end stream message is handled by httpc_response and will +%% be sent by answer_request +end_stream(_, #request{stream = none}) -> + ?hcrt("end stream - none", []), + ok; +end_stream(_, #request{stream = self}) -> + ?hcrt("end stream - self", []), + ok; +end_stream(_, #request{stream = {self, once}}) -> + ?hcrt("end stream - self:once", []), + ok; +end_stream({_,200,_}, #request{stream = Fd}) -> + ?hcrt("end stream - 200", [{stream, Fd}]), + case file:close(Fd) of + ok -> + ok; + {error, enospc} -> % Could be due to delayed_write + file:close(Fd) + end; +end_stream({_,206,_}, #request{stream = Fd}) -> + ?hcrt("end stream - 206", [{stream, Fd}]), + case file:close(Fd) of + ok -> + ok; + {error, enospc} -> % Could be due to delayed_write + file:close(Fd) + end; +end_stream(SL, R) -> + ?hcrt("end stream", [{status_line, SL}, {request, R}]), + ok. + + +next_body_chunk(#state{request = #request{stream = {self, once}}, + once = once, session = Session} = State) -> + http_transport:setopts(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + [{active, once}]), + State#state{once = inactive}; +next_body_chunk(#state{request = #request{stream = {self, once}}, + once = inactive} = State) -> + State; %% Wait for user to call stream_next +next_body_chunk(#state{session = Session} = State) -> + http_transport:setopts(socket_type(Session#tcp_session.scheme), + Session#tcp_session.socket, + [{active, once}]), + State. + +handle_verbose(verbose) -> + dbg:p(self(), [r]); +handle_verbose(debug) -> + dbg:p(self(), [call]), + dbg:tp(?MODULE, [{'_', [], [{return_trace}]}]); +handle_verbose(trace) -> + dbg:p(self(), [call]), + dbg:tpl(?MODULE, [{'_', [], [{return_trace}]}]); +handle_verbose(_) -> + ok. + +%%% Normaly I do not comment out code, I throw it away. But this might +%%% actually be used one day if ssl is improved. +%% send_ssl_tunnel_request(Address, Request = #request{address = {Host, Port}}, +%% State) -> +%% %% A ssl tunnel request is a special http request that looks like +%% %% CONNECT host:port HTTP/1.1 +%% SslTunnelRequest = #request{method = connect, scheme = http, +%% headers = +%% #http_request_h{ +%% host = Host, +%% address = Address, +%% path = Host ++ ":", +%% pquery = integer_to_list(Port), +%% other = [{ "Proxy-Connection", "keep-alive"}]}, +%% Ipv6 = (State#state.options)#options.ipv6, +%% SocketType = socket_type(SslTunnelRequest), +%% case http_transport:connect(SocketType, +%% SslTunnelRequest#request.address, Ipv6) of +%% {ok, Socket} -> +%% case httpc_request:send(Address, SslTunnelRequest, Socket) of +%% ok -> +%% Session = #tcp_session{id = +%% {SslTunnelRequest#request.address, +%% self()}, +%% scheme = +%% SslTunnelRequest#request.scheme, +%% socket = Socket}, +%% NewState = State#state{mfa = +%% {httpc_response, parse, +%% [State#state.max_header_size]}, +%% request = Request, +%% session = Session}, +%% http_transport:setopts(socket_type( +%% SslTunnelRequest#request.scheme), +%% Socket, +%% [{active, once}]), +%% {ok, NewState}; +%% {error, Reason} -> +%% self() ! {init_error, error_sending, +%% httpc_response:error(Request, Reason)}, +%% {ok, State#state{request = Request, +%% session = #tcp_session{socket = +%% Socket}}} +%% end; +%% {error, Reason} -> +%% self() ! {init_error, error_connecting, +%% httpc_response:error(Request, Reason)}, +%% {ok, State#state{request = Request}} +%% end. + +%% d(F) -> +%% d(F, []). + +%% d(F, A) -> +%% d(get(dbg), F, A). + +%% d(true, F, A) -> +%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]); +%% d(_, _, _) -> +%% ok. + diff --git a/lib/inets/src/http_client/httpc_handler_sup.erl b/lib/inets/src/http_client/httpc_handler_sup.erl new file mode 100644 index 0000000000..d9edaa0599 --- /dev/null +++ b/lib/inets/src/http_client/httpc_handler_sup.erl @@ -0,0 +1,66 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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(httpc_handler_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). +-export([start_child/1]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +start_child(Args) -> + supervisor:start_child(?MODULE, Args). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init(Args) -> + RestartStrategy = simple_one_for_one, + MaxR = 0, + MaxT = 3600, + + Name = undefined, % As simple_one_for_one is used. + StartFunc = {httpc_handler, start_link, Args}, + Restart = temporary, % E.g. should not be restarted + Shutdown = 4000, + Modules = [httpc_handler], + Type = worker, + + ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, + {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}. + + + + + + + + + + diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl new file mode 100644 index 0000000000..ec709b9860 --- /dev/null +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -0,0 +1,136 @@ +%% +%% %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("inets_internal.hrl"). +-define(SERVICE, httpc). +-define(hcri(Label, Data), ?report_important(Label, ?SERVICE, Data)). +-define(hcrv(Label, Data), ?report_verbose(Label, ?SERVICE, Data)). +-define(hcrd(Label, Data), ?report_debug(Label, ?SERVICE, Data)). +-define(hcrt(Label, Data), ?report_trace(Label, ?SERVICE, Data)). + +-define(HTTP_REQUEST_TIMEOUT, infinity). +-define(HTTP_REQUEST_CTIMEOUT, ?HTTP_REQUEST_TIMEOUT). +-define(HTTP_PIPELINE_TIMEOUT, 0). +-define(HTTP_PIPELINE_LENGTH, 2). +-define(HTTP_MAX_TCP_SESSIONS, 2). +-define(HTTP_MAX_REDIRECTS, 4). +-define(HTTP_KEEP_ALIVE_TIMEOUT, 120000). +-define(HTTP_KEEP_ALIVE_LENGTH, 5). + +%%% HTTP Client per request settings +-record(http_options, + { + %% string() - "HTTP/1.1" | "HTTP/1.0" | "HTTP/0.9" + version, + + %% integer() | infinity - ms before a request times out + timeout = ?HTTP_REQUEST_TIMEOUT, + + %% bool() - true if auto redirect on 30x response + autoredirect = true, + + %% Ssl socket options + ssl = [], + + %% {User, Password} = {string(), string()} + proxy_auth, + + %% bool() - true if not strictly std compliant + relaxed = false, + + %% integer() - ms before a connect times out + connect_timeout = ?HTTP_REQUEST_CTIMEOUT + } + ). + +%%% HTTP Client per profile setting. +-record(options, + { + proxy = {undefined, []}, % {{ProxyHost, ProxyPort}, [NoProxy]}, + %% 0 means persistent connections are used without pipelining + pipeline_timeout = ?HTTP_PIPELINE_TIMEOUT, + max_pipeline_length = ?HTTP_PIPELINE_LENGTH, + max_keep_alive_length = ?HTTP_KEEP_ALIVE_LENGTH, + keep_alive_timeout = ?HTTP_KEEP_ALIVE_TIMEOUT, % Used when pipeline_timeout = 0 + max_sessions = ?HTTP_MAX_TCP_SESSIONS, + cookies = disabled, % enabled | disabled | verify + verbose = false, + ipfamily = inet, % inet | inet6 | inet6fb4 + ip = default, % specify local interface + port = default % specify local port + } + ). + +%%% All data associated to a specific HTTP request +-record(request, + { + id, % ref() - Request Id + from, % pid() - Caller + redircount = 0,% Number of redirects made for this request + scheme, % http | https + address, % ({Host,Port}) Destination Host and Port + path, % string() - Path of parsed URL + pquery, % string() - Rest of parsed URL + method, % atom() - HTTP request Method + headers, % #http_request_h{} + content, % {ContentType, Body} - Current HTTP request + settings, % #http_options{} - User defined settings + abs_uri, % string() ex: "http://www.erlang.org" + userinfo, % string() - optinal "<userinfo>@<host>:<port>" + stream, % Boolean() - stream async reply? + headers_as_is % Boolean() - workaround for servers that does + %% not honor the http standard, can also be used for testing purposes. + } + ). + +-record(tcp_session, + { + id, % {{Host, Port}, HandlerPid} + client_close, % true | false + scheme, % http (HTTP/TCP) | https (HTTP/SSL/TCP) + socket, % Open socket, used by connection + queue_length = 1, % Current length of pipeline or keep alive queue + type % pipeline | keep_alive (wait for response before sending new request) + }). + +-record(http_cookie, + { + domain, + domain_default = false, + name, + value, + comment, + max_age = session, + path, + path_default = false, + secure = false, + version = "0" + }). + + +%% -record(parsed_uri, +%% { +%% scheme, % http | https +%% uinfo, % string() +%% host, % string() +%% port, % integer() +%% path, % string() +%% q % query: string() +%% }). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl new file mode 100644 index 0000000000..63b00c7dce --- /dev/null +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -0,0 +1,634 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-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(httpc_manager). + +-behaviour(gen_server). + +-include("httpc_internal.hrl"). +-include("http_internal.hrl"). + +%% Internal Application API +-export([start_link/1, start_link/2, request/2, cancel_request/2, + request_canceled/2, retry_request/2, redirect_request/2, + insert_session/2, delete_session/2, set_options/2, store_cookies/3, + cookies/2, session_type/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, + code_change/3]). + +-record(state, { + cancel = [], % [{RequestId, HandlerPid, ClientPid}] + handler_db, % ets() - Entry: {Requestid, HandlerPid, ClientPid} + cookie_db, % {ets(), dets()} - {session_cookie_db, cookie_db} + session_db, % ets() - Entry: #tcp_session{} + profile_name, % atom() + options = #options{} + }). + + +%%==================================================================== +%% Internal Application API +%%==================================================================== +%%-------------------------------------------------------------------- +%% Function: start_link({ProfileName, CookieDir}) -> {ok, Pid} +%% +%% ProfileName - httpc_manager_<Profile> +%% CookieDir - directory() +%% +%% Description: Starts the http request manger process. (Started by +%% the intes supervisor.) +%%-------------------------------------------------------------------- +start_link({default, CookieDir}) -> + gen_server:start_link({local, ?MODULE}, ?MODULE, + [?MODULE, {http_default_cookie_db, CookieDir}], + []); +start_link({Profile, CookieDir}) -> + ProfileName = list_to_atom("httpc_manager_" ++ atom_to_list(Profile)), + gen_server:start_link({local, ProfileName}, ?MODULE, + [ProfileName, + {http_default_cookie_db, CookieDir}], []). +start_link({Profile, CookieDir}, stand_alone) -> + ProfileName = list_to_atom("stand_alone_" ++ atom_to_list(Profile)), + gen_server:start_link(?MODULE, [ProfileName, + {http_default_cookie_db, CookieDir}], + []). +%%-------------------------------------------------------------------- +%% Function: request(Request, ProfileName) -> +%% {ok, Requestid} | {error, Reason} +%% Request = #request{} +%% ProfileName = atom() +%% +%% Description: Sends a request to the httpc manager process. +%%-------------------------------------------------------------------- +request(Request, ProfileName) -> + call(ProfileName, {request, Request}, infinity). + +%%-------------------------------------------------------------------- +%% Function: retry_request(Request, ProfileName) -> _ +%% Request = #request{} +%% ProfileName = atom() +%% +%% Description: Resends a request to the httpc manager process, intended +%% to be called by the httpc handler process if it has to terminate with +%% a non empty pipeline. +%%-------------------------------------------------------------------- +retry_request(Request, ProfileName) -> + cast(ProfileName, {retry_or_redirect_request, Request}). + +%%-------------------------------------------------------------------- +%% Function: redirect_request(Request, ProfileName) -> _ +%% Request = #request{} +%% ProfileName = atom() +%% +%% Description: Sends an atoumatic redirect request to the httpc +%% manager process, intended to be called by the httpc handler process +%% when the automatic redirect option is set. +%%-------------------------------------------------------------------- +redirect_request(Request, ProfileName) -> + cast(ProfileName, {retry_or_redirect_request, Request}). + +%%-------------------------------------------------------------------- +%% Function: cancel_request(RequestId, ProfileName) -> ok +%% RequestId - ref() +%% ProfileName = atom() +%% +%% Description: Cancels the request with <RequestId>. +%%-------------------------------------------------------------------- +cancel_request(RequestId, ProfileName) -> + call(ProfileName, {cancel_request, RequestId}, infinity). + +%%-------------------------------------------------------------------- +%% Function: request_canceled(RequestId, ProfileName) -> ok +%% RequestId - ref() +%% ProfileName = atom() +%% +%% Description: Confirms that a request has been canceld. Intended to +%% be called by the httpc handler process. +%%-------------------------------------------------------------------- +request_canceled(RequestId, ProfileName) -> + cast(ProfileName, {request_canceled, RequestId}). + +%%-------------------------------------------------------------------- +%% Function: insert_session(Session, ProfileName) -> _ +%% Session - #tcp_session{} +%% ProfileName - atom() +%% +%% Description: Inserts session information into the httpc manager +%% table <ProfileName>_session_db. Intended to be called by +%% the httpc request handler process. +%%-------------------------------------------------------------------- +insert_session(Session, ProfileName) -> + Db = list_to_atom(atom_to_list(ProfileName) ++ "_session_db"), + ets:insert(Db, Session). + +%%-------------------------------------------------------------------- +%% Function: delete_session(SessionId, ProfileName) -> _ +%% SessionId - {{Host, Port}, HandlerPid} +%% ProfileName - atom() +%% +%% Description: Deletes session information from the httpc manager +%% table httpc_manager_session_db_<Profile>. Intended to be called by +%% the httpc request handler process. +%%-------------------------------------------------------------------- +delete_session(SessionId, ProfileName) -> + Db = list_to_atom(atom_to_list(ProfileName) ++ "_session_db"), + ets:delete(Db, SessionId). + +%%-------------------------------------------------------------------- +%% Function: set_options(Options, ProfileName) -> ok +%% +%% Options = [Option] +%% Option = {proxy, {Proxy, [NoProxy]}} +%% | {max_pipeline_length, integer()} | +%% {max_sessions, integer()} | {pipeline_timeout, integer()} +%% Proxy = {Host, Port} +%% NoProxy - [Domain | HostName | IPAddress] +%% Max - integer() +%% ProfileName = atom() +%% +%% Description: Sets the options to be used by the client. +%%-------------------------------------------------------------------- +set_options(Options, ProfileName) -> + cast(ProfileName, {set_options, Options}). + +%%-------------------------------------------------------------------- +%% Function: store_cookies(Cookies, Address, ProfileName) -> ok +%% +%% Cookies = [Cookie] +%% Cookie = #http_cookie{} +%% ProfileName = atom() +%% +%% Description: Stores cookies from the server. +%%-------------------------------------------------------------------- +store_cookies([], _, _) -> + ok; +store_cookies(Cookies, Address, ProfileName) -> + cast(ProfileName, {store_cookies, {Cookies, Address}}). + +%%-------------------------------------------------------------------- +%% Function: cookies(Url, ProfileName) -> ok +%% +%% Url = string() +%% ProfileName = atom() +%% +%% Description: Retrieves the cookies that would be sent when +%% requesting <Url>. +%%-------------------------------------------------------------------- +cookies(Url, ProfileName) -> + call(ProfileName, {cookies, Url}, infinity). + +%%-------------------------------------------------------------------- +%% Function: session_type(Options) -> ok +%% +%% Options = #options{} +%% +%% Description: Determines if to use pipelined sessions or not. +%%-------------------------------------------------------------------- +session_type(#options{pipeline_timeout = 0}) -> + keep_alive; +session_type(_) -> + pipeline. + +%%==================================================================== +%% gen_server callback functions +%%==================================================================== + +%%-------------------------------------------------------------------- +%% Function: init([ProfileName, CookiesConf]) -> {ok, State} | +%% {ok, State, Timeout} | ignore |{stop, Reason} +%% Description: Initiates the httpc_manger process +%%-------------------------------------------------------------------- +init([ProfileName, CookiesConf | _]) -> + process_flag(trap_exit, true), + SessionDb = list_to_atom(atom_to_list(ProfileName) ++ "_session_db"), + ets:new(SessionDb, + [public, set, named_table, {keypos, #tcp_session.id}]), + ?hcri("starting", [{profile, ProfileName}]), + {ok, #state{handler_db = ets:new(handler_db, [protected, set]), + cookie_db = + http_cookie:open_cookie_db({CookiesConf, + http_session_cookie_db}), + session_db = SessionDb, + profile_name = ProfileName + }}. + +%%-------------------------------------------------------------------- +%% Function: handle_call(Request, From, State) -> {reply, Reply, State} | +%% {reply, Reply, State, Timeout} | +%% {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, Reply, State} | (terminate/2 is called) +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling call messages +%%-------------------------------------------------------------------- +handle_call({request, Request}, _, State) -> + ?hcri("request", [{request, Request}]), + case (catch handle_request(Request, State)) of + {reply, Msg, NewState} -> + {reply, Msg, NewState}; + Error -> + {stop, Error, httpc_response:error(Request, Error), State} + end; + +handle_call({cancel_request, RequestId}, From, State) -> + ?hcri("cancel_request", [{request_id, RequestId}]), + case ets:lookup(State#state.handler_db, RequestId) of + [] -> + ok, %% Nothing to cancel + {reply, ok, State}; + [{_, Pid, _}] -> + httpc_handler:cancel(RequestId, Pid), + {noreply, State#state{cancel = + [{RequestId, Pid, From} | + State#state.cancel]}} + end; + +handle_call({cookies, Url}, _, State) -> + case http_uri:parse(Url) of + {Scheme, _, Host, Port, Path, _} -> + CookieHeaders = + http_cookie:header(Scheme, {Host, Port}, + Path, State#state.cookie_db), + {reply, CookieHeaders, State}; + Msg -> + {reply, Msg, State} + end; + +handle_call(Msg, From, State) -> + Report = io_lib:format("HTTPC_MANAGER recived unkown call: ~p" + "from: ~p~n", [Msg, From]), + error_logger:error_report(Report), + {reply, {error, 'API_violation'}, State}. + +%%-------------------------------------------------------------------- +%% Function: handle_cast(Msg, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast({retry_or_redirect_request, {Time, Request}}, + #state{profile_name = ProfileName} = State) -> + {ok, _} = timer:apply_after(Time, ?MODULE, retry_request, [Request, ProfileName]), + {noreply, State}; + +handle_cast({retry_or_redirect_request, Request}, State) -> + case (catch handle_request(Request, State)) of + {reply, {ok, _}, NewState} -> + {noreply, NewState}; + Error -> + httpc_response:error(Request, Error), + {stop, Error, State} + end; + +handle_cast({request_canceled, RequestId}, State) -> + ets:delete(State#state.handler_db, RequestId), + case lists:keysearch(RequestId, 1, State#state.cancel) of + {value, Entry = {RequestId, _, From}} -> + gen_server:reply(From, ok), + {noreply, + State#state{cancel = lists:delete(Entry, State#state.cancel)}}; + _ -> + {noreply, State} + end; +handle_cast({set_options, Options}, State = #state{options = OldOptions}) -> + NewOptions = + #options{proxy = get_proxy(Options, OldOptions), + pipeline_timeout = get_pipeline_timeout(Options, OldOptions), + max_pipeline_length = get_max_pipeline_length(Options, OldOptions), + max_keep_alive_length = get_max_keep_alive_length(Options, OldOptions), + keep_alive_timeout = get_keep_alive_timeout(Options, OldOptions), + max_sessions = get_max_sessions(Options, OldOptions), + cookies = get_cookies(Options, OldOptions), + ipfamily = get_ipfamily(Options, OldOptions), + ip = get_ip(Options, OldOptions), + port = get_port(Options, OldOptions), + verbose = get_verbose(Options, OldOptions) + }, + case {OldOptions#options.verbose, NewOptions#options.verbose} of + {Same, Same} -> + ok; + {_, false} -> + dbg:stop(); + {false, Level} -> + dbg:tracer(), + handle_verbose(Level); + {_, Level} -> + dbg:stop(), + dbg:tracer(), + handle_verbose(Level) + end, + {noreply, State#state{options = NewOptions}}; + +handle_cast({store_cookies, _}, + State = #state{options = #options{cookies = disabled}}) -> + {noreply, State}; + +handle_cast({store_cookies, {Cookies, _}}, State) -> + ok = do_store_cookies(Cookies, State), + {noreply, State}; + +handle_cast(Msg, State) -> + Report = io_lib:format("HTTPC_MANAGER recived unkown cast: ~p", + [Msg]), + error_logger:error_report(Report), + {noreply, State}. + + + +%%-------------------------------------------------------------------- +%% Function: handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling all non call/cast messages +%%--------------------------------------------------------- +handle_info({'EXIT', _, _}, State) -> + %% Handled in DOWN + {noreply, State}; +handle_info({'DOWN', _, _, Pid, _}, State) -> + ets:match_delete(State#state.handler_db, {'_', Pid, '_'}), + + %% If there where any canceled request, handled by the + %% the process that now has terminated, the + %% cancelation can be viewed as sucessfull! + NewCanceldList = + lists:foldl(fun(Entry = {_, HandlerPid, From}, Acc) -> + case HandlerPid of + Pid -> + gen_server:reply(From, ok), + lists:delete(Entry, Acc); + _ -> + Acc + end + end, State#state.cancel, State#state.cancel), + {noreply, State#state{cancel = NewCanceldList}}; +handle_info(Info, State) -> + Report = io_lib:format("Unknown message in " + "httpc_manager:handle_info ~p~n", [Info]), + error_logger:error_report(Report), + {noreply, State}. +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> _ (ignored by gen_server) +%% Description: Shutdown the httpc_handler +%%-------------------------------------------------------------------- +terminate(_, State) -> + http_cookie:close_cookie_db(State#state.cookie_db), + ets:delete(State#state.session_db), + ets:delete(State#state.handler_db). + +%%-------------------------------------------------------------------- +%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} +%% Purpose: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%% Internal functions +%%-------------------------------------------------------------------- +handle_request(#request{settings = + #http_options{version = "HTTP/0.9"}} = Request, + State) -> + %% Act as an HTTP/0.9 client that does not know anything + %% about persistent connections + + NewRequest = handle_cookies(generate_request_id(Request), State), + NewHeaders = + (NewRequest#request.headers)#http_request_h{connection + = undefined}, + start_handler(NewRequest#request{headers = NewHeaders}, State), + {reply, {ok, NewRequest#request.id}, State}; + +handle_request(#request{settings = + #http_options{version = "HTTP/1.0"}} = Request, + State) -> + %% Act as an HTTP/1.0 client that does not + %% use persistent connections + + NewRequest = handle_cookies(generate_request_id(Request), State), + NewHeaders = + (NewRequest#request.headers)#http_request_h{connection + = "close"}, + start_handler(NewRequest#request{headers = NewHeaders}, State), + {reply, {ok, NewRequest#request.id}, State}; + +handle_request(Request, State = #state{options = Options}) -> + + NewRequest = handle_cookies(generate_request_id(Request), State), + SessionType = session_type(Options), + case select_session(Request#request.method, + Request#request.address, + Request#request.scheme, SessionType, State) of + {ok, HandlerPid} -> + pipeline_or_keep_alive(NewRequest, HandlerPid, State); + no_connection -> + start_handler(NewRequest, State); + {no_session, OpenSessions} when OpenSessions + < Options#options.max_sessions -> + start_handler(NewRequest, State); + {no_session, _} -> + %% Do not start any more persistent connections + %% towards this server. + NewHeaders = + (NewRequest#request.headers)#http_request_h{connection + = "close"}, + start_handler(NewRequest#request{headers = NewHeaders}, State) + end, + {reply, {ok, NewRequest#request.id}, State}. + +select_session(Method, HostPort, Scheme, SessionTyp, + #state{options = #options{max_pipeline_length = + MaxPipe, + max_keep_alive_length = MaxKeepAlive}, + session_db = SessionDb}) -> + case httpc_request:is_idempotent(Method) or (SessionTyp == keep_alive) of + true -> + Candidates = ets:match(SessionDb, + {'_', {HostPort, '$1'}, + false, Scheme, '_', '$2', SessionTyp}), + select_session(Candidates, MaxKeepAlive, MaxPipe, SessionTyp); + false -> + no_connection + end. + +select_session(Candidates, Max, _, keep_alive) -> + select_session(Candidates, Max); +select_session(Candidates, _, Max, pipeline) -> + select_session(Candidates, Max). + +select_session(Candidates, Max) -> + case Candidates of + [] -> + no_connection; + _ -> + NewCandidates = + lists:foldl( + fun([Pid, Length], Acc) when Length =< Max -> + [{Pid, Length} | Acc]; + (_, Acc) -> + Acc + end, [], Candidates), + + case lists:keysort(2, NewCandidates) of + [] -> + {no_session, length(Candidates)}; + [{HandlerPid, _} | _] -> + {ok, HandlerPid} + end + end. + +pipeline_or_keep_alive(Request, HandlerPid, State) -> + case (catch httpc_handler:send(Request, HandlerPid)) of + ok -> + ets:insert(State#state.handler_db, {Request#request.id, + HandlerPid, + Request#request.from}); + _ -> %timeout pipelining failed + start_handler(Request, State) + end. + +start_handler(Request, State) -> + {ok, Pid} = + case is_inets_manager() of + true -> + httpc_handler_sup:start_child([Request, State#state.options, + State#state.profile_name]); + false -> + httpc_handler:start_link(Request, State#state.options, + State#state.profile_name) + end, + ets:insert(State#state.handler_db, {Request#request.id, + Pid, Request#request.from}), + erlang:monitor(process, Pid). + +is_inets_manager() -> + case get('$ancestors') of + [httpc_profile_sup | _] -> + true; + _ -> + false + end. + +generate_request_id(Request) -> + case Request#request.id of + undefined -> + RequestId = make_ref(), + Request#request{id = RequestId}; + _ -> + %% This is an automatic redirect or a retryed pipelined + %% request keep the old id. + Request + end. + +handle_cookies(Request, #state{options = #options{cookies = disabled}}) -> + Request; +handle_cookies(Request = #request{scheme = Scheme, address = Address, + path = Path, headers = + Headers = #http_request_h{other = Other}}, + #state{cookie_db = Db}) -> + case http_cookie:header(Scheme, Address, Path, Db) of + {"cookie", ""} -> + Request; + CookieHeader -> + NewHeaders = + Headers#http_request_h{other = [CookieHeader | Other]}, + Request#request{headers = NewHeaders} + end. + +do_store_cookies([], _) -> + ok; +do_store_cookies([Cookie | Cookies], State) -> + ok = http_cookie:insert(Cookie, State#state.cookie_db), + do_store_cookies(Cookies, State). + +call(ProfileName, Msg, Timeout) -> + gen_server:call(ProfileName, Msg, Timeout). + +cast(ProfileName, Msg) -> + gen_server:cast(ProfileName, Msg). + + + +get_proxy(Opts, #options{proxy = Default}) -> + proplists:get_value(proxy, Opts, Default). + +get_pipeline_timeout(Opts, #options{pipeline_timeout = Default}) -> + proplists:get_value(pipeline_timeout, Opts, Default). + +get_max_pipeline_length(Opts, #options{max_pipeline_length = Default}) -> + proplists:get_value(max_pipeline_length, Opts, Default). + +get_max_keep_alive_length(Opts, #options{max_keep_alive_length = Default}) -> + proplists:get_value(max_keep_alive_length, Opts, Default). + +get_keep_alive_timeout(Opts, #options{keep_alive_timeout = Default}) -> + proplists:get_value(keep_alive_timeout, Opts, Default). + +get_max_sessions(Opts, #options{max_sessions = Default}) -> + proplists:get_value(max_sessions, Opts, Default). + +get_cookies(Opts, #options{cookies = Default}) -> + proplists:get_value(cookies, Opts, Default). + +get_ipfamily(Opts, #options{ipfamily = IpFamily}) -> + case lists:keysearch(ipfamily, 1, Opts) of + false -> + case proplists:get_value(ipv6, Opts) of + enabled -> + inet6fb4; + disabled -> + inet; + _ -> + IpFamily + end; + {value, {_, Value}} -> + Value + end. + +get_ip(Opts, #options{ip = Default}) -> + proplists:get_value(ip, Opts, Default). + +get_port(Opts, #options{port = Default}) -> + proplists:get_value(port, Opts, Default). + +get_verbose(Opts, #options{verbose = Default}) -> + proplists:get_value(verbose, Opts, Default). + + +handle_verbose(debug) -> + dbg:p(self(), [call]), + dbg:tp(?MODULE, [{'_', [], [{return_trace}]}]); +handle_verbose(trace) -> + dbg:p(self(), [call]), + dbg:tpl(?MODULE, [{'_', [], [{return_trace}]}]); +handle_verbose(_) -> + ok. + +%% d(F) -> +%% d(F, []). + +%% d(F, A) -> +%% d(get(dbg), F, A). + +%% d(true, F, A) -> +%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]); +%% d(_, _, _) -> +%% ok. + diff --git a/lib/inets/src/http_client/httpc_profile_sup.erl b/lib/inets/src/http_client/httpc_profile_sup.erl new file mode 100644 index 0000000000..2351083435 --- /dev/null +++ b/lib/inets/src/http_client/httpc_profile_sup.erl @@ -0,0 +1,107 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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(httpc_profile_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/1]). +-export([start_child/1, restart_child/1, stop_child/1]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link(HttpcServices) -> + supervisor:start_link({local, ?MODULE}, ?MODULE, [HttpcServices]). + +start_child(PropList) -> + case proplists:get_value(profile, PropList) of + undefined -> + {error, no_profile}; + Profile -> + Dir = proplists:get_value(data_dir, PropList, only_session_cookies), + Spec = httpc_child_spec(Profile, Dir), + supervisor:start_child(?MODULE, Spec) + end. + +restart_child(Profile) -> + Name = id(Profile), + case supervisor:terminate_child(?MODULE, Name) of + ok -> + supervisor:restart_child(?MODULE, Name); + Error -> + Error + end. + +stop_child(Profile) -> + Name = id(Profile), + case supervisor:terminate_child(?MODULE, Name) of + ok -> + supervisor:delete_child(?MODULE, Name); + Error -> + Error + end. + +id(Profile) -> + DefaultProfile = http:default_profile(), + case Profile of + DefaultProfile -> + httpc_manager; + _ -> + {http, Profile} + end. + + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init([]) -> + init([[]]); +init([HttpcServices]) -> + RestartStrategy = one_for_one, + MaxR = 10, + MaxT = 3600, + Children = child_spec(HttpcServices, []), + {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. + +child_spec([], Acc) -> + Acc; +%% For backwards compatibility +child_spec([{httpc, {Profile, Dir}} | Rest], Acc) -> + Spec = httpc_child_spec(Profile, Dir), + child_spec(Rest, [Spec | Acc]); +child_spec([{httpc, PropList} | Rest], Acc) when is_list(PropList) -> + Profile = proplists:get_value(profile, PropList), + Dir = proplists:get_value(data_dir, PropList), + Spec = httpc_child_spec(Profile, Dir), + child_spec(Rest, [Spec | Acc]). + +httpc_child_spec(Profile, Dir) -> + Name = id(Profile), + StartFunc = {httpc_manager, start_link, [{Profile, Dir}]}, + Restart = permanent, + Shutdown = 4000, + Modules = [httpc_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl new file mode 100644 index 0000000000..3d66638d66 --- /dev/null +++ b/lib/inets/src/http_client/httpc_request.erl @@ -0,0 +1,209 @@ +%% +%% %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% +%% + +-module(httpc_request). + +-include("http_internal.hrl"). +-include("httpc_internal.hrl"). + +%%% Internal API +-export([send/3, is_idempotent/1, is_client_closing/1]). + +%%%========================================================================= +%%% Internal application API +%%%========================================================================= +%%------------------------------------------------------------------------- +%% send(MaybeProxy, Request) -> +%% MaybeProxy - {Host, Port} +%% Host = string() +%% Port = integer() +%% Request - #request{} +%% Socket - socket() +%% CookieSupport - enabled | disabled | verify +%% +%% Description: Composes and sends a HTTP-request. +%%------------------------------------------------------------------------- +send(SendAddr, #request{method = Method, scheme = Scheme, + path = Path, pquery = Query, headers = Headers, + content = Content, address = Address, + abs_uri = AbsUri, headers_as_is = HeadersAsIs, + settings = HttpOptions, + userinfo = UserInfo}, + Socket) -> + + TmpHeaders = handle_user_info(UserInfo, Headers), + + {TmpHeaders2, Body} = + post_data(Method, TmpHeaders, Content, HeadersAsIs), + + {NewHeaders, Uri} = case Address of + SendAddr -> + {TmpHeaders2, Path ++ Query}; + _Proxy -> + TmpHeaders3 = + handle_proxy(HttpOptions, TmpHeaders2), + {TmpHeaders3, AbsUri} + end, + + FinalHeaders = case NewHeaders of + HeaderList when is_list(HeaderList) -> + http_headers(HeaderList, []); + _ -> + http_request:http_headers(NewHeaders) + end, + Version = HttpOptions#http_options.version, + + Message = [method(Method), " ", Uri, " ", + version(Version), ?CRLF, headers(FinalHeaders, Version), ?CRLF, Body], + + http_transport:send(socket_type(Scheme), Socket, lists:append(Message)). + +%%------------------------------------------------------------------------- +%% is_idempotent(Method) -> +%% Method = atom() +%% +%% Description: Checks if Method is considered idempotent. +%%------------------------------------------------------------------------- + +%% In particular, the convention has been established that the GET and +%% HEAD methods SHOULD NOT have the significance of taking an action +%% other than retrieval. These methods ought to be considered "safe". +is_idempotent(head) -> + true; +is_idempotent(get) -> + true; +%% Methods can also have the property of "idempotence" in that (aside +%% from error or expiration issues) the side-effects of N > 0 +%% identical requests is the same as for a single request. +is_idempotent(put) -> + true; +is_idempotent(delete) -> + true; +%% Also, the methods OPTIONS and TRACE SHOULD NOT have side effects, +%% and so are inherently idempotent. +is_idempotent(trace) -> + true; +is_idempotent(options) -> + true; +is_idempotent(_) -> + false. + +%%------------------------------------------------------------------------- +%% is_client_closing(Headers) -> +%% Headers = #http_request_h{} +%% +%% Description: Checks if the client has supplied a "Connection: +%% close" header. +%%------------------------------------------------------------------------- +is_client_closing(Headers) -> + case Headers#http_request_h.connection of + "close" -> + true; + _ -> + false + end. + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +post_data(Method, Headers, {ContentType, Body}, HeadersAsIs) + when Method == post; Method == put -> + ContentLength = body_length(Body), + NewBody = case Headers#http_request_h.expect of + "100-continue" -> + ""; + _ -> + Body + end, + + NewHeaders = case HeadersAsIs of + [] -> + Headers#http_request_h{'content-type' = + ContentType, + 'content-length' = + ContentLength}; + _ -> + HeadersAsIs + end, + + {NewHeaders, NewBody}; + +post_data(_, Headers, _, []) -> + {Headers, ""}; +post_data(_, _, _, HeadersAsIs = [_|_]) -> + {HeadersAsIs, ""}. + +body_length(Body) when is_binary(Body) -> + integer_to_list(size(Body)); + +body_length(Body) when is_list(Body) -> + integer_to_list(length(Body)). + +method(Method) -> + http_util:to_upper(atom_to_list(Method)). + +version("HTTP/0.9") -> + ""; +version(Version) -> + Version. + +headers(_, "HTTP/0.9") -> + ""; +%% HTTP 1.1 headers not present in HTTP 1.0 should be +%% consider as unknown extension headers that should be +%% ignored. +headers(Headers, _) -> + Headers. + +socket_type(http) -> + ip_comm; +socket_type(https) -> + {ssl, []}. + +http_headers([], Headers) -> + lists:flatten(Headers); +http_headers([{Key,Value} | Rest], Headers) -> + Header = Key ++ ": " ++ Value ++ ?CRLF, + http_headers(Rest, [Header | Headers]). + +handle_proxy(_, Headers) when is_list(Headers) -> + Headers; %% Headers as is option was specified +handle_proxy(HttpOptions, Headers) -> + case HttpOptions#http_options.proxy_auth of + undefined -> + Headers; + {User, Password} -> + UserPasswd = base64:encode_to_string(User ++ ":" ++ Password), + Headers#http_request_h{'proxy-authorization' = + "Basic " ++ UserPasswd} + end. + +handle_user_info([], Headers) -> + Headers; +handle_user_info(UserInfo, Headers) -> + case string:tokens(UserInfo, ":") of + [User, Passwd] -> + UserPasswd = base64:encode_to_string(User ++ ":" ++ Passwd), + Headers#http_request_h{authorization = "Basic " ++ UserPasswd}; + [User] -> + UserPasswd = base64:encode_to_string(User ++ ":"), + Headers#http_request_h{authorization = "Basic " ++ UserPasswd}; + _ -> + Headers + end. diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl new file mode 100644 index 0000000000..e2ba66f730 --- /dev/null +++ b/lib/inets/src/http_client/httpc_response.erl @@ -0,0 +1,431 @@ +%% +%% %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% +%% + +-module(httpc_response). + +-include("http_internal.hrl"). +-include("httpc_internal.hrl"). + +%% API +-export([parse/1, result/2, send/2, error/2, is_server_closing/1, + stream_start/3]). + +%% Callback API - used for example if the header/body is received a +%% little at a time on a socket. +-export([parse_version/1, parse_status_code/1, parse_reason_phrase/1, + parse_headers/1, whole_body/1, whole_body/2]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +parse([Bin, MaxHeaderSize, Relaxed]) -> + parse_version(Bin, [], MaxHeaderSize, [], Relaxed). + +whole_body([Bin, Body, Length]) -> + whole_body(<<Body/binary, Bin/binary>>, Length). + +%% Functions that may be returned during the decoding process +%% if the input data is incompleate. +parse_version([Bin, Version, MaxHeaderSize, Result, Relaxed]) -> + parse_version(Bin, Version, MaxHeaderSize, Result, Relaxed). + +parse_status_code([Bin, Code, MaxHeaderSize, Result, Relaxed]) -> + parse_status_code(Bin, Code, MaxHeaderSize, Result, Relaxed). + +parse_reason_phrase([Bin, Rest, Phrase, MaxHeaderSize, Result, Relaxed]) -> + parse_reason_phrase(<<Rest/binary, Bin/binary>>, Phrase, + MaxHeaderSize, Result, Relaxed). + +parse_headers([Bin, Rest,Header, Headers, MaxHeaderSize, Result, Relaxed]) -> + parse_headers(<<Rest/binary, Bin/binary>>, Header, Headers, + MaxHeaderSize, Result, Relaxed). + +whole_body(Body, Length) -> + case size(Body) of + N when (N < Length) andalso (N > 0) -> + {?MODULE, whole_body, [Body, Length]}; + %% OBS! The Server may close the connection to indicate that the + %% whole body is now sent instead of sending a lengh + %% indicator.In this case the lengh indicator will be + %% -1. + N when (N >= Length) andalso (Length >= 0) -> + %% Potential trailing garbage will be thrown away in + %% format_response/1 Some servers may send a 100-continue + %% response without the client requesting it through an + %% expect header in this case the trailing bytes may be + %% part of the real response message. + {ok, Body}; + _ -> %% Length == -1 + {?MODULE, whole_body, [Body, Length]} + end. + +%%------------------------------------------------------------------------- +%% result(Response, Request) -> +%% Response - {StatusLine, Headers, Body} +%% Request - #request{} +%% Session - #tcp_session{} +%% +%% Description: Checks the status code ... +%%------------------------------------------------------------------------- +result(Response = {{_, Code,_}, _, _}, + Request = #request{stream = Stream}) + when ((Code =:= 200) orelse (Code =:= 206)) andalso (Stream =/= none) -> + stream_end(Response, Request); + +result(Response = {{_,100,_}, _, _}, Request) -> + status_continue(Response, Request); + +%% In redirect loop +result(Response = {{_, Code, _}, _, _}, Request = + #request{redircount = Redirects, + settings = #http_options{autoredirect = true}}) + when ((Code div 100) =:= 3) andalso (Redirects > ?HTTP_MAX_REDIRECTS) -> + transparent(Response, Request); + +%% multiple choices +result(Response = {{_, 300, _}, _, _}, + Request = #request{settings = + #http_options{autoredirect = + true}}) -> + redirect(Response, Request); + +result(Response = {{_, Code, _}, _, _}, + Request = #request{settings = + #http_options{autoredirect = true}, + method = head}) when (Code =:= 301) orelse + (Code =:= 302) orelse + (Code =:= 303) orelse + (Code =:= 307) -> + redirect(Response, Request); +result(Response = {{_, Code, _}, _, _}, + Request = #request{settings = + #http_options{autoredirect = true}, + method = get}) when (Code =:= 301) orelse + (Code =:= 302) orelse + (Code =:= 303) orelse + (Code =:= 307) -> + redirect(Response, Request); + + +result(Response = {{_,503,_}, _, _}, Request) -> + status_service_unavailable(Response, Request); +result(Response = {{_,Code,_}, _, _}, Request) when (Code div 100) =:= 5 -> + status_server_error_50x(Response, Request); + +result(Response, Request) -> + transparent(Response, Request). + +send(To, Msg) -> + To ! {http, Msg}. + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +parse_version(<<>>, Version, MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_version, [Version, MaxHeaderSize,Result, Relaxed]}; +parse_version(<<?SP, Rest/binary>>, Version, + MaxHeaderSize, Result, Relaxed) -> + case lists:reverse(Version) of + "HTTP/" ++ _ = Newversion -> + parse_status_code(Rest, [], MaxHeaderSize, + [Newversion | Result], Relaxed); + NewVersion -> + throw({error, {invalid_version, NewVersion}}) + end; + +parse_version(<<Octet, Rest/binary>>, Version, + MaxHeaderSize, Result, Relaxed) -> + parse_version(Rest, [Octet | Version], MaxHeaderSize,Result, Relaxed). + +parse_status_code(<<>>, StatusCodeStr, MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_status_code, + [StatusCodeStr, MaxHeaderSize, Result, Relaxed]}; + +%% Some Apache servers has been known to leave out the reason phrase, +%% in relaxed mode we will allow this. +parse_status_code(<<?CR>> = Data, StatusCodeStr, + MaxHeaderSize, Result, true) -> + {?MODULE, parse_status_code, + [Data, StatusCodeStr, MaxHeaderSize, Result, true]}; +parse_status_code(<<?LF>>, StatusCodeStr, + MaxHeaderSize, Result, true) -> + %% If ?CR is is missing RFC2616 section-19.3 + parse_status_code(<<?CR, ?LF>>, StatusCodeStr, + MaxHeaderSize, Result, true); + +parse_status_code(<<?CR, ?LF, Rest/binary>>, StatusCodeStr, + MaxHeaderSize, Result, true) -> + parse_headers(Rest, [], [], MaxHeaderSize, + [" ", list_to_integer(lists:reverse( + string:strip(StatusCodeStr))) + | Result], true); + +parse_status_code(<<?SP, Rest/binary>>, StatusCodeStr, + MaxHeaderSize, Result, Relaxed) -> + parse_reason_phrase(Rest, [], MaxHeaderSize, + [list_to_integer(lists:reverse(StatusCodeStr)) | + Result], Relaxed); + +parse_status_code(<<Octet, Rest/binary>>, StatusCodeStr, + MaxHeaderSize,Result, Relaxed) -> + parse_status_code(Rest, [Octet | StatusCodeStr], MaxHeaderSize, Result, + Relaxed). + +parse_reason_phrase(<<>>, Phrase, MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_reason_phrase, + [<<>>, Phrase, MaxHeaderSize, Result, Relaxed]}; + +parse_reason_phrase(<<?CR, ?LF, ?LF, Body/binary>>, Phrase, + MaxHeaderSize, Result, Relaxed) -> + %% If ?CR is is missing RFC2616 section-19.3 + parse_reason_phrase(<<?CR, ?LF, ?CR, ?LF, Body/binary>>, Phrase, + MaxHeaderSize, Result, Relaxed); + +parse_reason_phrase(<<?CR, ?LF, ?CR, ?LF, Body/binary>>, Phrase, + _, Result, _) -> + ResponseHeaderRcord = + http_response:headers([], #http_response_h{}), + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcord | + [lists:reverse(Phrase) | Result]]))}; + +parse_reason_phrase(<<?CR, ?LF, ?CR>> = Data, Phrase, MaxHeaderSize, Result, + Relaxed) -> + {?MODULE, parse_reason_phrase, [Data, Phrase, MaxHeaderSize, Result], + Relaxed}; + +parse_reason_phrase(<<?CR, ?LF>> = Data, Phrase, MaxHeaderSize, Result, + Relaxed) -> + {?MODULE, parse_reason_phrase, [Data, Phrase, MaxHeaderSize, Result, + Relaxed]}; +parse_reason_phrase(<<?LF, Rest/binary>>, Phrase, + MaxHeaderSize, Result, Relaxed) -> + %% If ?CR is is missing RFC2616 section-19.3 + parse_reason_phrase(<<?CR, ?LF, Rest/binary>>, Phrase, + MaxHeaderSize, Result, Relaxed); +parse_reason_phrase(<<?CR, ?LF, Rest/binary>>, Phrase, + MaxHeaderSize, Result, Relaxed) -> + parse_headers(Rest, [], [], MaxHeaderSize, + [lists:reverse(Phrase) | Result], Relaxed); +parse_reason_phrase(<<?LF>>, Phrase, MaxHeaderSize, Result, Relaxed) -> + %% If ?CR is is missing RFC2616 section-19.3 + parse_reason_phrase(<<?CR, ?LF>>, Phrase, MaxHeaderSize, Result, + Relaxed); +parse_reason_phrase(<<?CR>> = Data, Phrase, MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_reason_phrase, + [Data, Phrase, MaxHeaderSize, Result, Relaxed]}; +parse_reason_phrase(<<Octet, Rest/binary>>, Phrase, MaxHeaderSize, Result, + Relaxed) -> + parse_reason_phrase(Rest, [Octet | Phrase], MaxHeaderSize, + Result, Relaxed). + +parse_headers(<<>>, Header, Headers, MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_headers, [<<>>, Header, Headers, MaxHeaderSize, Result, + Relaxed]}; + +parse_headers(<<?CR,?LF,?LF,Body/binary>>, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + %% If ?CR is is missing RFC2616 section-19.3 + parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, + MaxHeaderSize, Result, Relaxed); + +parse_headers(<<?LF,?LF,Body/binary>>, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + %% If ?CR is is missing RFC2616 section-19.3 + parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, + MaxHeaderSize, Result, Relaxed); + +parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, + MaxHeaderSize, Result, _) -> + HTTPHeaders = [lists:reverse(Header) | Headers], + Length = lists:foldl(fun(H, Acc) -> length(H) + Acc end, + 0, HTTPHeaders), + case ((Length =< MaxHeaderSize) or (MaxHeaderSize == nolimit)) of + true -> + ResponseHeaderRcord = + http_response:headers(HTTPHeaders, #http_response_h{}), + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcord | Result]))}; + false -> + throw({error, {header_too_long, MaxHeaderSize, + MaxHeaderSize-Length}}) + end; +parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_headers, [Data, Header, Headers, + MaxHeaderSize, Result, Relaxed]}; +parse_headers(<<?CR,?LF>> = Data, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_headers, [Data, Header, Headers, MaxHeaderSize, + Result, Relaxed]}; +parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + parse_headers(Rest, [Octet], + [lists:reverse(Header) | Headers], MaxHeaderSize, + Result, Relaxed); +parse_headers(<<?CR>> = Data, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + {?MODULE, parse_headers, [Data, Header, Headers, MaxHeaderSize, + Result, Relaxed]}; + +parse_headers(<<?LF>>, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + %% If ?CR is is missing RFC2616 section-19.3 + parse_headers(<<?CR, ?LF>>, Header, Headers, + MaxHeaderSize, Result, Relaxed); + +parse_headers(<<Octet, Rest/binary>>, Header, Headers, + MaxHeaderSize, Result, Relaxed) -> + parse_headers(Rest, [Octet | Header], Headers, MaxHeaderSize, + Result, Relaxed). + + +%% RFC2616, Section 10.1.1 +%% Note: +%% - Only act on the 100 status if the request included the +%% "Expect:100-continue" header, otherwise just ignore this response. +status_continue(_, #request{headers = + #http_request_h{expect = "100-continue"}}) -> + continue; + +status_continue({_,_, Data}, _) -> + %% The data in the body in this case is actually part of the real + %% response sent after the "fake" 100-continue. + {ignore, Data}. + +status_service_unavailable(Response = {_, Headers, _}, Request) -> + case Headers#http_response_h.'retry-after' of + undefined -> + status_server_error_50x(Response, Request); + Time when (length(Time) < 3) -> % Wait only 99 s or less + NewTime = list_to_integer(Time) * 100, % time in ms + {_, Data} = format_response(Response), + {retry, {NewTime, Request}, Data}; + _ -> + status_server_error_50x(Response, Request) + end. + +status_server_error_50x(Response, Request) -> + {Msg, _} = format_response(Response), + {stop, {Request#request.id, Msg}}. + + +redirect(Response = {StatusLine, Headers, Body}, Request) -> + {_, Data} = format_response(Response), + case Headers#http_response_h.location of + undefined -> + transparent(Response, Request); + RedirUrl -> + case http_uri:parse(RedirUrl) of + {error, no_scheme} when + (Request#request.settings)#http_options.relaxed -> + NewLocation = fix_relative_uri(Request, RedirUrl), + redirect({StatusLine, Headers#http_response_h{ + location = NewLocation}, + Body}, Request); + {error, Reason} -> + {ok, error(Request, Reason), Data}; + %% Automatic redirection + {Scheme, _, Host, Port, Path, Query} -> + NewHeaders = + (Request#request.headers)#http_request_h{host = + Host}, + NewRequest = + Request#request{redircount = + Request#request.redircount+1, + scheme = Scheme, + headers = NewHeaders, + address = {Host,Port}, + path = Path, + pquery = Query, + abs_uri = + atom_to_list(Scheme) ++ "://" ++ + Host ++ ":" ++ + integer_to_list(Port) ++ + Path ++ Query}, + {redirect, NewRequest, Data} + end + end. + +maybe_to_list(Port) when is_integer(Port) -> + integer_to_list(Port); +maybe_to_list(Port) when is_list(Port) -> + Port. + +%%% Guessing that we received a relative URI, fix it to become an absoluteURI +fix_relative_uri(Request, RedirUrl) -> + {Server, Port0} = Request#request.address, + Port = maybe_to_list(Port0), + Path = Request#request.path, + atom_to_list(Request#request.scheme) ++ "://" ++ Server ++ ":" ++ Port + ++ Path ++ RedirUrl. + +error(#request{id = Id}, Reason) -> + {Id, {error, Reason}}. + +transparent(Response, Request) -> + {Msg, Data} = format_response(Response), + {ok, {Request#request.id, Msg}, Data}. + +stream_start(Headers, Request, ignore) -> + {Request#request.id, stream_start, http_response:header_list(Headers)}; + +stream_start(Headers, Request, Pid) -> + {Request#request.id, stream_start, + http_response:header_list(Headers), Pid}. + +stream_end(Response, Request = #request{stream = Self}) + when (Self =:= self) orelse (Self =:= {self, once}) -> + {{_, Headers, _}, Data} = format_response(Response), + {ok, {Request#request.id, stream_end, Headers}, Data}; + +stream_end(Response, Request) -> + {_, Data} = format_response(Response), + {ok, {Request#request.id, saved_to_file}, Data}. + +is_server_closing(Headers) when is_record(Headers, http_response_h) -> + case Headers#http_response_h.connection of + "close" -> + true; + _ -> + false + end. + +format_response({{"HTTP/0.9", _, _} = StatusLine, _, Body}) -> + {{StatusLine, [], Body}, <<>>}; +format_response({StatusLine, Headers, Body = <<>>}) -> + {{StatusLine, http_response:header_list(Headers), Body}, <<>>}; + +format_response({StatusLine, Headers, Body}) -> + Length = list_to_integer(Headers#http_response_h.'content-length'), + {NewBody, Data} = + case Length of + 0 -> + {Body, <<>>}; + -1 -> % When no lenght indicator is provided + {Body, <<>>}; + Length when (Length =< size(Body)) -> + <<BodyThisReq:Length/binary, Next/binary>> = Body, + {BodyThisReq, Next}; + _ -> %% Connection prematurely ended. + {Body, <<>>} + end, + {{StatusLine, http_response:header_list(Headers), NewBody}, Data}. + diff --git a/lib/inets/src/http_client/httpc_sup.erl b/lib/inets/src/http_client/httpc_sup.erl new file mode 100644 index 0000000000..152a57d32d --- /dev/null +++ b/lib/inets/src/http_client/httpc_sup.erl @@ -0,0 +1,75 @@ +%% +%% %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 client hangs under +%% inets_sup. +%%---------------------------------------------------------------------- + +-module(httpc_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/1]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link(HttpcServices) -> + supervisor:start_link({local, ?MODULE}, ?MODULE, [HttpcServices]). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init([HttpcServices]) -> + RestartStrategy = one_for_one, + MaxR = 10, + MaxT = 3600, + Children = child_specs(HttpcServices), + {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. + +%%%========================================================================= +%%% Internal functions +%%%========================================================================= +child_specs(HttpcServices) -> + [httpc_profile_sup(HttpcServices), httpc_handler_sup()]. + +httpc_profile_sup(HttpcServices) -> + Name = httpc_profile_sup, + StartFunc = {httpc_profile_sup, start_link, [HttpcServices]}, + Restart = permanent, + Shutdown = infinity, + Modules = [httpc_profile_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +httpc_handler_sup() -> + Name = httpc_handler_sup, + StartFunc = {httpc_handler_sup, start_link, []}, + Restart = permanent, + Shutdown = infinity, + Modules = [httpc_handler_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + + diff --git a/lib/inets/src/http_lib/Makefile b/lib/inets/src/http_lib/Makefile new file mode 100644 index 0000000000..27e7ee65c5 --- /dev/null +++ b/lib/inets/src/http_lib/Makefile @@ -0,0 +1,101 @@ +# +# %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 = \ + http_chunk \ + http_transport\ + http_util \ + http_request \ + http_response + +HRL_FILES = http_internal.hrl + +ERL_FILES = $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# INETS FLAGS +# ---------------------------------------------------- +INETS_FLAGS = -D'SERVER_SOFTWARE="inets/$(VSN)"' \ + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +INETS_ERL_FLAGS += -I ../inets_app + +ifeq ($(WARN_UNUSED_WARS),true) +ERL_COMPILE_FLAGS += +warn_unused_vars +endif + +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_lib/http_chunk.erl b/lib/inets/src/http_lib/http_chunk.erl new file mode 100644 index 0000000000..cd20dce9d5 --- /dev/null +++ b/lib/inets/src/http_lib/http_chunk.erl @@ -0,0 +1,291 @@ +%% +%% %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% +%% +%% Description: Implements chunked transfer encoding see RFC2616 section +%% 3.6.1 +-module(http_chunk). + +-include("http_internal.hrl"). + +%% API +-export([decode/3, decode/4, encode/1, encode_last/0, handle_headers/2]). +%% Callback API - used for example if the chunkedbody is received a +%% little at a time on a socket. +-export([decode_size/1, ignore_extensions/1, decode_data/1, decode_trailer/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +%%------------------------------------------------------------------------- +%% decode(ChunkedBody, MaxBodySize, MaxHeaderSize, <Stream>) -> +%% {ok, {Headers, Body}} | {Module, Function, Args} +%% +%% Headers = ["Header:Value"] +%% ChunkedBody = binary() +%% MaxBodySize = integer() +%% MaxHeaderSize = integer() +%% Stream = {Code, Request} - if Request#request.stream =/= none +%% and Code == 200 the side effect of sending each decode chunk to the +%% client/file before the whole body is received will take place. +%% +%% Note: decode/4 should only be used from httpc_handler module. +%% Otherwhise use the side effect free decode/3. +%% +%% Description: Decodes a body encoded by the chunked transfer +%% encoding. If the ChunkedBody is not compleate it returns {Module, +%% Function, Args} so that decoding can be continued when more of the +%% data has been received by calling Module:Function([NewData | Args]). +%% +%% Note: In the case of pipelining a call to decode might contain data +%% that belongs to the next request/response and will be returned as +%% part of the body, hence functions calling http_chunk:decode must +%% look at the returned content-length header to make sure that they +%% split the actual body and data that possible should be passed along to +%% the next pass in the loop. +%%------------------------------------------------------------------------- +decode(ChunkedBody, MaxBodySize, MaxHeaderSize) -> + decode(ChunkedBody, MaxBodySize, MaxHeaderSize, false). + +decode(ChunkedBody, MaxBodySize, MaxHeaderSize, Stream) -> + %% Note decode_size will call decode_data. + decode_size([ChunkedBody, <<>>, [], + {MaxBodySize, <<>>, 0, MaxHeaderSize, Stream}]). + +%%------------------------------------------------------------------------- +%% encode(Chunk) -> EncodedChunk +%% +%% Chunked = binary() +%% EncodedChunk = binary() +%% +%% Description: Encodes a body part with the chunked transfer encoding. +%% Chunks are returned as lists or binaries depending on the +%% input format. When sending the data on the both formats +%% are accepted. +%%------------------------------------------------------------------------- +encode(Chunk) when is_binary(Chunk)-> + HEXSize = list_to_binary(http_util:integer_to_hexlist(size(Chunk))), + <<HEXSize/binary, ?CR, ?LF, Chunk/binary, ?CR, ?LF>>; + +encode(Chunk) when is_list(Chunk)-> + HEXSize = http_util:integer_to_hexlist(erlang:iolist_size(Chunk)), + [HEXSize, ?CR, ?LF, Chunk, ?CR, ?LF]. + +encode_last() -> + <<$0, ?CR, ?LF, ?CR, ?LF >>. + +%%------------------------------------------------------------------------- +%% handle_headers(HeaderRecord, ChunkedHeaders) -> NewHeaderRecord +%% +%% HeaderRecord = NewHeaderRecord = #http_request_h{} | #http_response_h{} +%% ChunkedHeaders = ["Header:Value"] as returnde by http_chunk:decode/3 +%% +%% Description: Removes chunked from the header as we now have decode +%% the body and adds a content-length header and any other headers +%% found in the chunked trail. +%%------------------------------------------------------------------------- +handle_headers(RequestHeaderRecord = #http_request_h{}, ChunkedHeaders) -> + NewHeaders = http_request:headers(ChunkedHeaders, RequestHeaderRecord), + TransferEncoding = + case NewHeaders#http_request_h.'transfer-encoding' -- "chunked" of + "" -> + undefined; + Other -> + Other + end, + NewHeaders#http_request_h{'transfer-encoding' = TransferEncoding}; + +handle_headers(ResponseHeaderRecord = #http_response_h{}, ChunkedHeaders) -> + NewHeaders = http_response:headers(ChunkedHeaders, ResponseHeaderRecord), + TransferEncoding = + case NewHeaders#http_response_h.'transfer-encoding' -- "chunked" of + "" -> + undefined; + Other -> + Other + end, + NewHeaders#http_response_h{'transfer-encoding' = TransferEncoding}. + +%% Functions that may be returned during the decoding process +%% if the input data is incompleate. +decode_size([Bin, Rest, HexList, Info]) -> + decode_size(<<Rest/binary, Bin/binary>>, HexList, Info). + +ignore_extensions([Bin, Rest, NextFunction]) -> + ignore_extensions(<<Rest/binary, Bin/binary>>, NextFunction). + +decode_data([Bin, ChunkSize, TotalChunk, Info]) -> + decode_data(ChunkSize, <<TotalChunk/binary, Bin/binary>>, Info). + +decode_trailer([Bin, Rest, Header, Headers, MaxHeaderSize, Body, + BodyLength]) -> + decode_trailer(<<Rest/binary, Bin/binary>>, + Header, Headers, MaxHeaderSize, Body, BodyLength). + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +decode_size(<<>>, HexList, Info) -> + {?MODULE, decode_size, [<<>>, HexList, Info]}; +decode_size(Data = <<?CR, ?LF, ChunkRest/binary>>, HexList, + {MaxBodySize, Body, + AccLength, + MaxHeaderSize, Stream}) -> + ChunkSize = http_util:hexlist_to_integer(lists:reverse(HexList)), + case ChunkSize of + 0 -> % Last chunk, there was no data + ignore_extensions(Data, {?MODULE, decode_trailer, + [<<>>, [],[], MaxHeaderSize, + Body, + integer_to_list(AccLength)]}); + _ -> + %% Note decode_data may call decode_size again if there + %% is more than one chunk, hence here is where the last parameter + %% to this function comes in. + decode_data(ChunkSize, ChunkRest, {MaxBodySize, Body, + ChunkSize + AccLength , + MaxHeaderSize, Stream}) + end; +decode_size(<<";", Rest/binary>>, HexList, Info) -> + %% Note ignore_extensions will call decode_size/1 again when + %% it ignored all extensions. + ignore_extensions(Rest, {?MODULE, decode_size, [<<>>, HexList, Info]}); +decode_size(<<?CR>> = Data, HexList, Info) -> + {?MODULE, decode_size, [Data, HexList, Info]}; +decode_size(<<Octet, Rest/binary>>, HexList, Info) -> + decode_size(Rest, [Octet | HexList], Info). + +%% "All applications MUST ignore chunk-extension extensions they +%% do not understand.", see RFC 2616 Section 3.6.1 We don't +%% understand any extension... +ignore_extensions(<<>>, NextFunction) -> + {?MODULE, ignore_extensions, [<<>>, NextFunction]}; +ignore_extensions(Data = <<?CR, ?LF, _ChunkRest/binary>>, + {Module, Function, Args}) -> + Module:Function([Data | Args]); +ignore_extensions(<<?CR>> = Data, NextFunction) -> + {?MODULE, ignore_extensions, [Data, NextFunction]}; +ignore_extensions(<<_Octet, Rest/binary>>, NextFunction) -> + ignore_extensions(Rest, NextFunction). + +decode_data(ChunkSize, TotalChunk, + Info = {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize, Stream}) + when ChunkSize =< size(TotalChunk) -> + case TotalChunk of + %% Potential last chunk + <<_:ChunkSize/binary, ?CR, ?LF, "0">> -> + {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]}; + <<_:ChunkSize/binary, ?CR, ?LF, "0", ?CR>> -> + {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]}; + <<_:ChunkSize/binary, ?CR, ?LF>> -> + {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]}; + %% Last chunk + <<Data:ChunkSize/binary, ?CR, ?LF, "0", ";">> -> + %% Note ignore_extensions will call decode_trailer/1 + %% once it ignored all extensions. + {NewBody, _} = + stream(<<BodySoFar/binary, Data/binary>>, Stream), + {?MODULE, ignore_extensions, + [<<>>, + {?MODULE, decode_trailer, [<<>>, [],[], MaxHeaderSize, + NewBody, + integer_to_list(AccLength)]}]}; + <<Data:ChunkSize/binary, ?CR, ?LF, "0", ";", Rest/binary>> -> + %% Note ignore_extensions will call decode_trailer/1 + %% once it ignored all extensions. + {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream), + ignore_extensions(Rest, {?MODULE, decode_trailer, + [<<>>, [],[], MaxHeaderSize, + NewBody, + integer_to_list(AccLength)]}); + <<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF>> -> + {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream), + {?MODULE, decode_trailer, [<<?CR, ?LF>>, [],[], MaxHeaderSize, + NewBody, + integer_to_list(AccLength)]}; + <<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF, Rest/binary>> -> + {NewBody,_}= stream(<<BodySoFar/binary, Data/binary>>, Stream), + decode_trailer(<<?CR, ?LF, Rest/binary>>, [],[], MaxHeaderSize, + NewBody, + integer_to_list(AccLength)); + %% There are more chunks, so here we go agin... + <<Data:ChunkSize/binary, ?CR, ?LF, Rest/binary>> + when (AccLength < MaxBodySize) or (MaxBodySize == nolimit) -> + {NewBody, NewStream} = + stream(<<BodySoFar/binary, Data/binary>>, Stream), + decode_size(Rest, [], + {MaxBodySize, NewBody, + AccLength, MaxHeaderSize, NewStream}); + <<_:ChunkSize/binary, ?CR, ?LF, _/binary>> -> + throw({error, body_too_big}); + _ -> + {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]} + end; +decode_data(ChunkSize, TotalChunk, Info) -> + {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]}. + +decode_trailer(<<>>, Header, Headers, MaxHeaderSize, Body, BodyLength) -> + {?MODULE, decode_trailer, [<<>>, Header, Headers, MaxHeaderSize, Body, + BodyLength]}; + +%% Note: If Bin is not empty it is part of a pipelined request/response. +decode_trailer(<<?CR,?LF,?CR,?LF, Bin/binary>>, [], [], _, Body, BodyLength) -> + {ok, {["content-length:" ++ BodyLength], <<Body/binary, Bin/binary>>}}; +decode_trailer(<<?CR,?LF,?CR,?LF, Bin/binary>>, + Header, Headers, MaxHeaderSize, Body, BodyLength) -> + NewHeaders = case Header of + [] -> + Headers; + _ -> + [lists:reverse(Header) | Headers] + end, + Length = length(NewHeaders), + case Length > MaxHeaderSize of + true -> + throw({error, {header_too_long, MaxHeaderSize, + MaxHeaderSize-Length}}); + false -> + {ok, {["content-length:" ++ BodyLength | NewHeaders], + <<Body/binary, Bin/binary>>}} + end; +decode_trailer(<<?CR,?LF,?CR>> = Data, Header, Headers, MaxHeaderSize, + Body, BodyLength) -> + {?MODULE, decode_trailer, [Data, Header, Headers, MaxHeaderSize, Body, + BodyLength]}; +decode_trailer(<<?CR,?LF>> = Data, Header, Headers, MaxHeaderSize, + Body, BodyLength) -> + {?MODULE, decode_trailer, [Data, Header, Headers, MaxHeaderSize, Body, + BodyLength]}; +decode_trailer(<<?CR>> = Data, Header, Headers, MaxHeaderSize, + Body, BodyLength) -> + {?MODULE, decode_trailer, [Data, Header, Headers, MaxHeaderSize, Body, + BodyLength]}; +decode_trailer(<<?CR, ?LF, Rest/binary>>, Header, Headers, + MaxHeaderSize, Body, BodyLength) -> + decode_trailer(Rest, [], [lists:reverse(Header) | Headers], + MaxHeaderSize, Body, BodyLength); + +decode_trailer(<<Octet, Rest/binary>>, Header, Headers, MaxHeaderSize, Body, + BodyLength) -> + decode_trailer(Rest, [Octet | Header], Headers, MaxHeaderSize, + Body, BodyLength). + +stream(BodyPart, false) -> + {BodyPart, false}; +stream(BodyPart, {Code, Request}) -> + {NewBody, NewRequest} = httpc_handler:stream(BodyPart, Request, Code), + {NewBody, {Code, NewRequest}}. diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl new file mode 100644 index 0000000000..bb2e831727 --- /dev/null +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -0,0 +1,108 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-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("inets_internal.hrl"). + +-define(HTTP_MAX_BODY_SIZE, nolimit). +-define(HTTP_MAX_HEADER_SIZE, 10240). +-define(HTTP_MAX_URI_SIZE, nolimit). + +%%% Response headers +-record(http_response_h,{ +%%% --- Standard "General" headers + 'cache-control', + connection, + date, + pragma, + trailer, + 'transfer-encoding', + upgrade, + via, + warning, +%%% --- Standard "Response" headers + 'accept-ranges', + age, + etag, + location, + 'proxy-authenticate', + 'retry-after', + server, + vary, + 'www-authenticate', +%%% --- Standard "Entity" headers + allow, + 'content-encoding', + 'content-language', + 'content-length' = "-1", + 'content-location', + 'content-md5', + 'content-range', + 'content-type', + expires, + 'last-modified', + other=[] % list() - Key/Value list with other headers + }). + + +%%% Request headers +-record(http_request_h,{ +%%% --- Standard "General" headers + 'cache-control', + connection = "keep-alive", + date, + pragma, + trailer, + 'transfer-encoding', + upgrade, + via, + warning, +%%% --- Standard "Request" headers + accept, + 'accept-charset', + 'accept-encoding', + 'accept-language', + authorization, + expect, + from, + host, + 'if-match', + 'if-modified-since', + 'if-none-match', + 'if-range', + 'if-unmodified-since', + 'max-forwards', + 'proxy-authorization', + range, + referer, + te, + 'user-agent', +%%% --- Standard "Entity" headers + allow, + 'content-encoding', + 'content-language', + 'content-length' = "0", + 'content-location', + 'content-md5', + 'content-range', + 'content-type', + expires, + 'last-modified', + other=[] % list() - Key/Value list with other headers + }). diff --git a/lib/inets/src/http_lib/http_request.erl b/lib/inets/src/http_lib/http_request.erl new file mode 100644 index 0000000000..c214aca4a4 --- /dev/null +++ b/lib/inets/src/http_lib/http_request.erl @@ -0,0 +1,281 @@ +%% +%% %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(http_request). + +-include("http_internal.hrl"). + +-export([headers/2, http_headers/1, is_absolut_uri/1]). + +%%------------------------------------------------------------------------- +%% headers(HeaderList, #http_request_h{}) -> #http_request_h{} +%% HeaderList - ["HeaderField:Value"] +%% HeaderField - string() +%% Value - string() +%% +%% Description: Creates a http_request_h-record used internally to +%% handle http-headers. +%%------------------------------------------------------------------------- +headers([], Headers) -> + Headers; +headers([Header | Tail], Headers) -> + case lists:splitwith(fun($:) -> false; (_) -> true end, Header) of + {Key, [$: | Value]} -> + headers(Tail, headers(http_util:to_lower(string:strip(Key)), + string:strip(Value), Headers)); + {_, []} -> + Report = io_lib:format("Ignored invalid HTTP-header: ~p~n", + [Header]), + error_logger:error_report(Report), + headers(Tail, Headers) + end. + +%%------------------------------------------------------------------------- +%% headers(#http_request_h{}) -> HeaderList +%% HeaderList - ["HeaderField:Value"] +%% HeaderField - string() +%% Value - string() +%% +%% Description: Creates a HTTP header string. +%%------------------------------------------------------------------------- +http_headers(Headers = #http_request_h{other = Other}) -> + HeaderFields = record_info(fields, http_request_h) -- [other], + HeaderStr = lists:foldl(fun(Key, Acc) -> + case key_value_str(Key, Headers) of + undefined -> + Acc; + Str -> + [Str | Acc] + end + end, + [], HeaderFields), + + lists:flatten([HeaderStr | headers_other(Other, [])]). + +%%------------------------------------------------------------------------- +%% is_absolut_uri(URI) -> true | false +%% URI - string() +%% +%% Description: Checks if an URI is absolute or relative +%%------------------------------------------------------------------------- +is_absolut_uri("http://" ++ _) -> + true; +is_absolut_uri("https://" ++ _) -> + true; +is_absolut_uri(_) -> + false. + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%%% --- Request headers +headers("accept", Value, Headers) -> + Headers#http_request_h{accept = Value}; +headers("accept-charset", Value, Headers) -> + Headers#http_request_h{'accept-charset' = Value}; +headers("accept-encoding", Value, Headers) -> + Headers#http_request_h{'accept-encoding' = Value}; +headers("accept-language", Value, Headers) -> + Headers#http_request_h{'accept-language' = Value}; +headers("authorization", Value, Headers) -> + Headers#http_request_h{authorization = Value}; +headers("expect", Value, Headers) -> + Headers#http_request_h{expect = Value}; +headers("from", Value, Headers) -> + Headers#http_request_h{from = Value}; +headers("host", Value, Headers) -> + Headers#http_request_h{host = Value}; +headers("if-match", Value, Headers) -> + Headers#http_request_h{'if-match' = Value}; +headers("if-modified-since", Value, Headers) -> + Headers#http_request_h{'if-modified-since' = Value}; +headers("if-none-match", Value, Headers) -> + Headers#http_request_h{'if-none-match' = Value}; +headers("if-range", Value, Headers) -> + Headers#http_request_h{'if-range' = Value}; +headers("if-unmodified-since", Value, Headers) -> + Headers#http_request_h{'if-unmodified-since' = Value}; +headers("max-forwards", Value, Headers) -> + Headers#http_request_h{'max-forwards' = Value}; +headers("proxy-authorization", Value, Headers) -> + Headers#http_request_h{'proxy-authorization' = Value}; +headers("range", Value, Headers) -> + Headers#http_request_h{range = Value}; +headers("referer", Value, Headers) -> + Headers#http_request_h{referer = Value}; +headers("te", Value, Headers) -> + Headers#http_request_h{te = Value}; +headers("user-agent", Value, Headers) -> + Headers#http_request_h{'user-agent' = Value}; + +%% General-Headers +headers("cache-control", Value, Headers) -> + Headers#http_request_h{'cache-control' = Value}; +headers("connection", Value, Headers) -> + Headers#http_request_h{connection = Value}; +headers("date", Value, Headers) -> + Headers#http_request_h{date = Value}; +headers("pragma", Value, Headers) -> + Headers#http_request_h{pragma = Value}; +headers("trailer", Value, Headers) -> + Headers#http_request_h{trailer = Value}; +headers("transfer-encoding", Value, Headers) -> + Headers#http_request_h{'transfer-encoding' = Value}; +headers("upgrade", Value, Headers) -> + Headers#http_request_h{upgrade = Value}; +headers("via", Value, Headers) -> + Headers#http_request_h{via = Value}; +headers("warning", Value, Headers) -> + Headers#http_request_h{warning = Value}; + +%% Entity header +headers("allow", Value, Headers) -> + Headers#http_request_h{allow = Value}; +headers("content-encoding", Value, Headers) -> + Headers#http_request_h{'content-encoding' = Value}; +headers("content-language", Value, Headers) -> + Headers#http_request_h{'content-language' = Value}; +headers("content-length", Value, Headers) -> + Headers#http_request_h{'content-length' = Value}; +headers("content-location", Value, Headers) -> + Headers#http_request_h{'content-location' = Value}; +headers("content-md5", Value, Headers) -> + Headers#http_request_h{'content-md5' = Value}; +headers("content-range", Value, Headers) -> + Headers#http_request_h{'content-range' = Value}; +headers("content-type", Value, Headers) -> + Headers#http_request_h{'content-type' = Value}; +headers("expires", Value, Headers) -> + Headers#http_request_h{expires = Value}; +headers("last-modified", Value, Headers) -> + Headers#http_request_h{'last-modified' = Value}; +headers(Key, Value, Headers) -> + Headers#http_request_h{other= + [{Key, Value} | Headers#http_request_h.other]}. + +key_value_str(Key = 'cache-control', Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.'cache-control'); +key_value_str(Key = connection, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.connection); +key_value_str(Key = date, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.date); +key_value_str(Key = pragma, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.pragma); +key_value_str(Key = trailer, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.trailer); +key_value_str(Key = 'transfer-encoding', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'transfer-encoding'); +key_value_str(Key = upgrade, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.upgrade); +key_value_str(Key = via, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.via); +key_value_str(Key = warning, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.warning); +key_value_str(Key = accept, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.accept); +key_value_str(Key = 'accept-charset', Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.'accept-charset'); +key_value_str(Key = 'accept-encoding', Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.'accept-encoding'); +key_value_str(Key = 'accept-language', Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.'accept-language'); +key_value_str(Key = authorization, Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.authorization); +key_value_str(Key = expect, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.expect); +key_value_str(Key = from, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.from); +key_value_str(Key = host, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.host); +key_value_str(Key = 'if-match', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'if-match'); +key_value_str(Key = 'if-modified-since', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'if-modified-since'); +key_value_str(Key = 'if-none-match', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'if-none-match'); +key_value_str(Key = 'if-range', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'if-range'); +key_value_str(Key = 'if-unmodified-since', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'if-unmodified-since'); +key_value_str(Key = 'max-forwards', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'max-forwards'); +key_value_str(Key = 'proxy-authorization', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'proxy-authorization'); +key_value_str(Key = range, Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.range); +key_value_str(Key = referer, Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.referer); +key_value_str(Key = te, Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.te); +key_value_str(Key = 'user-agent', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'user-agent'); +key_value_str(Key = allow, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.allow); +key_value_str(Key = 'content-encoding', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'content-encoding'); +key_value_str(Key = 'content-language', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'content-language'); +key_value_str(Key = 'content-length', Headers) -> + case Headers#http_request_h.'content-length' of + "0" -> + undefined; + _ -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'content-length') + end; +key_value_str(Key = 'content-location', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'content-location'); +key_value_str(Key = 'content-md5', Headers) -> + key_value_str(atom_to_list(Key), + Headers#http_request_h.'content-md5'); +key_value_str(Key = 'content-range', Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.'content-range'); +key_value_str(Key = 'content-type', Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.'content-type'); +key_value_str(Key = expires, Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.expires); +key_value_str(Key = 'last-modified', Headers) -> + key_value_str(atom_to_list(Key), Headers#http_request_h.'last-modified'); +key_value_str(_, undefined) -> + undefined; +key_value_str(Key, Value) -> + Key ++ ": " ++ Value ++ ?CRLF. + +headers_other([], Headers) -> + Headers; +headers_other([{Key,Value} | Rest], Headers) -> + Header = Key ++ ": " ++ Value ++ ?CRLF, + headers_other(Rest, [Header | Headers]). diff --git a/lib/inets/src/http_lib/http_response.erl b/lib/inets/src/http_lib/http_response.erl new file mode 100644 index 0000000000..b1e7f1e647 --- /dev/null +++ b/lib/inets/src/http_lib/http_response.erl @@ -0,0 +1,208 @@ +%% +%% %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(http_response). + +-include("http_internal.hrl"). + +-export([headers/2, header_list/1]). + +%%------------------------------------------------------------------------- +%% headers(HeaderList, #http_response_h{}) -> #http_response_h{} +%% HeaderList - ["HeaderField:Value"] +%% HeaderField - string() +%% Value - string() +%% +%% Description: Creates a http_response_h-record used internally to +%% handle http-headers. +%%------------------------------------------------------------------------- +headers([], Headers) -> + Headers; + +headers([Header | Tail], Headers) -> + {Key, [$: | Value]} = + lists:splitwith(fun($:) -> false; (_) -> true end, Header), + headers(Tail, headers(http_util:to_lower(string:strip(Key)), + string:strip(Value), Headers)). + +%%------------------------------------------------------------------------- +%% headers(#http_response_h{}) -> HeaderList +%% HeaderList - [{"HeaderField", Value"}] +%% HeaderField - string() +%% Value - string() +%% +%% Description: Creates a list of key value tuples from the #http_response_h +%% record, to be returned to the application programmer. We +%% do not wish to make the application programmer dependent on +%% our records. +%%------------------------------------------------------------------------- +header_list(Headers) -> + HeaderFields = record_info(fields, http_response_h) -- [other], + HeaderList = lists:foldl(fun(Key, Acc) -> + case key_value_tuple(Key, Headers) of + undefined -> + Acc; + Tuple -> + [Tuple | Acc] + end + end, + [], HeaderFields), + lists:reverse(HeaderList) ++ Headers#http_response_h.other. +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +headers("cache-control", Value, Headers) -> + Headers#http_response_h{'cache-control'= Value}; +headers("connection", Value, Headers) -> + Headers#http_response_h{connection = Value}; +headers("date", Value, Headers) -> + Headers#http_response_h{date = Value}; +headers("pragma", Value, Headers) -> + Headers#http_response_h{pragma = Value}; +headers("trailer", Value, Headers) -> + Headers#http_response_h{trailer = Value}; +headers("transfer-encoding", Value, Headers) -> + Headers#http_response_h{'transfer-encoding' = Value}; +headers("upgrade", Value, Headers) -> + Headers#http_response_h{upgrade = Value}; +headers("via", Value, Headers) -> + Headers#http_response_h{via = Value}; +headers("warning", Value, Headers) -> + Headers#http_response_h{warning = Value}; +headers("accept-ranges", Value, Headers) -> + Headers#http_response_h{'accept-ranges' = Value}; +headers("age", Value, Headers) -> + Headers#http_response_h{age = Value}; +headers("etag", Value, Headers) -> + Headers#http_response_h{etag = Value}; +headers("location", Value, Headers) -> + Headers#http_response_h{location = Value}; +headers("proxy-authenticate", Value, Headers) -> + Headers#http_response_h{'proxy-authenticate' = Value}; +headers("retry-after", Value, Headers) -> + Headers#http_response_h{'retry-after' = Value}; +headers("server", Value, Headers) -> + Headers#http_response_h{server = Value}; +headers("vary", Value, Headers) -> + Headers#http_response_h{vary = Value}; +headers("www-authenticate", Value, Headers) -> + Headers#http_response_h{'www-authenticate' = Value}; +headers("allow", Value, Headers) -> + Headers#http_response_h{allow = Value}; +headers("content-encoding", Value, Headers) -> + Headers#http_response_h{'content-encoding' = Value}; +headers("content-language", Value, Headers) -> + Headers#http_response_h{'content-language' = Value}; +headers("content-length", Value, Headers) -> + Headers#http_response_h{'content-length' = Value}; +headers("content-location", Value, Headers) -> + Headers#http_response_h{'content-location' = Value}; +headers("content-md5", Value, Headers) -> + Headers#http_response_h{'content-md5' = Value}; +headers("content-range", Value, Headers) -> + Headers#http_response_h{'content-range' = Value}; +headers("content-type", Value, Headers) -> + Headers#http_response_h{'content-type' = Value}; +headers("expires", Value, Headers) -> + Headers#http_response_h{expires = Value}; +headers("last-modified", Value, Headers) -> + Headers#http_response_h{'last-modified' = Value}; +headers(Key, Value, Headers) -> + Headers#http_response_h{other= + [{Key, Value} | Headers#http_response_h.other]}. + + +key_value_tuple(Key = 'cache-control', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'cache-control'); +key_value_tuple(Key = connection, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.connection); +key_value_tuple(Key = date, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.date); +key_value_tuple(Key = pragma, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.pragma); +key_value_tuple(Key = trailer, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.trailer); +key_value_tuple(Key ='transfer-encoding', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'transfer-encoding'); +key_value_tuple(Key = upgrade, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.upgrade); +key_value_tuple(Key = via, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.via); +key_value_tuple(Key = warning, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.warning); +key_value_tuple(Key = 'accept-ranges', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'accept-ranges'); +key_value_tuple(Key = age, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.age); +key_value_tuple(Key = etag, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.etag); +key_value_tuple(Key = location, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.location); +key_value_tuple(Key = 'proxy-authenticate', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'proxy-authenticate'); +key_value_tuple(Key = 'retry-after', Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.'retry-after'); +key_value_tuple(Key = server, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.server); +key_value_tuple(Key = vary, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.vary); +key_value_tuple(Key = 'www-authenticate', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'www-authenticate'); +key_value_tuple(Key = allow, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.allow); +key_value_tuple(Key = 'content-encoding', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'content-encoding'); +key_value_tuple(Key = 'content-language', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'content-language'); +key_value_tuple(Key = 'content-length', Headers) -> + case Headers#http_response_h.'content-length' of + "-1" -> + undefined; + _ -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'content-length') + end; +key_value_tuple(Key = 'content-location', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'content-location'); +key_value_tuple(Key = 'content-md5', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'content-md5'); +key_value_tuple(Key = 'content-range', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'content-range'); +key_value_tuple(Key = 'content-type', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'content-type'); +key_value_tuple(Key = expires, Headers) -> + key_value_tuple(atom_to_list(Key), Headers#http_response_h.expires); +key_value_tuple(Key = 'last-modified', Headers) -> + key_value_tuple(atom_to_list(Key), + Headers#http_response_h.'last-modified'); +key_value_tuple(_, undefined) -> + undefined; +key_value_tuple(Key, Value) -> + {Key, Value}. diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl new file mode 100644 index 0000000000..8100d7183a --- /dev/null +++ b/lib/inets/src/http_lib/http_transport.erl @@ -0,0 +1,353 @@ +%% +%% %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% +%% +% +-module(http_transport). + +% Internal application API +-export([start/1, connect/3, connect/4, listen/2, listen/3, + accept/2, accept/3, close/2, + send/3, controlling_process/3, setopts/3, + peername/2, resolve/0]). + +-export([negotiate/3]). + + +%%%========================================================================= +%%% Internal application API +%%%========================================================================= + +%%------------------------------------------------------------------------- +%% start(SocketType) -> ok | {error, Reason} +%% SocketType = ip_comm | {ssl, _} +%% +%% Description: Makes sure inet_db or ssl is started. +%%------------------------------------------------------------------------- +start(ip_comm) -> + case inet_db:start() of + {ok, _} -> + ok; + {error, {already_started, _}} -> + ok; + Error -> + Error + end; +start({ssl, _}) -> + case ssl:start() of + ok -> + ok; + {error, {already_started,_}} -> + ok; + Error -> + Error + end. + + +%%------------------------------------------------------------------------- +%% connect(SocketType, Address, Options, Timeout) -> +%% {ok, Socket} | {error, Reason} +%% SocketType = ip_comm | {ssl, SslConfig} +%% Address = {Host, Port} +%% Options = [option()] +%% Socket = socket() +%% option() = ipfamily() | {ip, ip_address()} | {port, integer()} +%% ipfamily() = inet | inet6 +%% +%% Description: Connects to the Host and Port specified in HTTPRequest. +%%------------------------------------------------------------------------- + +connect(SocketType, Address, Opts) -> + connect(SocketType, Address, Opts, infinity). + +connect(ip_comm = _SocketType, {Host, Port}, Opts0, Timeout) + when is_list(Opts0) -> + Opts = [binary, {packet, 0}, {active, false}, {reuseaddr, true} | Opts0], + gen_tcp:connect(Host, Port, Opts, Timeout); + +connect({ssl, SslConfig}, {Host, Port}, _, Timeout) -> + Opts = [binary, {active, false}] ++ SslConfig, + ssl:connect(Host, Port, Opts, Timeout); + +connect({erl_ssl, SslConfig}, {Host, Port}, _, Timeout) -> + Opts = [binary, {active, false}, {ssl_imp, new}] ++ SslConfig, + ssl:connect(Host, Port, Opts, Timeout). + + +%%------------------------------------------------------------------------- +%% listen(SocketType, Port) -> {ok, Socket} | {error, Reason} +%% SocketType = ip_comm | {ssl, SSLConfig} +%% Port = integer() +%% Socket = socket() +%% +%% Description: Sets up socket to listen on the port Port on the local +%% host using either gen_tcp or ssl. In the gen_tcp case the port +%% might allready have been initiated by a wrapper-program and is +%% given as an Fd that can be retrieved by init:get_argument. The +%% reason for this to enable a HTTP-server not running as root to use +%% port 80. +%%------------------------------------------------------------------------- +listen(SocketType, Port) -> + listen(SocketType, undefined, Port). + +listen(ip_comm, Addr, Port) -> + case (catch listen_ip_comm(Addr, Port)) of + {'EXIT', Reason} -> + {error, {exit, Reason}}; + Else -> + Else + end; + +listen({ssl, SSLConfig} = Ssl, Addr, Port) -> + Opt = sock_opt(Ssl, Addr, SSLConfig), + ssl:listen(Port, Opt); + +listen({erl_ssl, SSLConfig} = Ssl, Addr, Port) -> + Opt = sock_opt(Ssl, Addr, SSLConfig), + ssl:listen(Port, [{ssl_imp, new} | Opt]). + + +listen_ip_comm(Addr, Port) -> + {NewPort, Opts, IpFamily} = get_socket_info(Addr, Port), + case IpFamily of + inet6fb4 -> + Opts2 = [inet6 | Opts], + case (catch gen_tcp:listen(NewPort, Opts2)) of + {error, Reason} when ((Reason =:= nxdomain) orelse + (Reason =:= eafnosupport)) -> + Opts3 = [inet | Opts], + gen_tcp:listen(NewPort, Opts3); + + %% This is when a given hostname has resolved to a + %% IPv4-address. The inet6-option together with a + %% {ip, IPv4} option results in badarg + {'EXIT', _} -> + Opts3 = [inet | Opts], + gen_tcp:listen(NewPort, Opts3); + + Other -> + Other + end; + _ -> + Opts2 = [IpFamily | Opts], + gen_tcp:listen(NewPort, Opts2) + end. + +ipfamily_default(Addr, Port) -> + httpd_conf:lookup(Addr, Port, ipfamily, inet6fb4). + +get_socket_info(Addr, Port) -> + Key = list_to_atom("httpd_" ++ integer_to_list(Port)), + BaseOpts = [{backlog, 128}, {reuseaddr, true}], + IpFamilyDefault = ipfamily_default(Addr, Port), + case init:get_argument(Key) of + {ok, [[Value]]} -> + {Fd, IpFamily} = + case string:tokens(Value, [$|]) of + [FdStr, IpFamilyStr] -> + Fd0 = fd_of(FdStr), + IpFamily0 = ip_family_of(IpFamilyStr), + {Fd0, IpFamily0}; + [FdStr] -> + {fd_of(FdStr), IpFamilyDefault}; + _ -> + throw({error, {bad_descriptor, Value}}) + end, + {0, sock_opt(ip_comm, Addr, [{fd, Fd} | BaseOpts]), IpFamily}; + error -> + {Port, sock_opt(ip_comm, Addr, BaseOpts), IpFamilyDefault} + end. + + +fd_of(FdStr) -> + case (catch list_to_integer(FdStr)) of + Fd when is_integer(Fd) -> + Fd; + _ -> + throw({error, {bad_descriptor, FdStr}}) + end. + +ip_family_of(IpFamilyStr) -> + IpFamily = list_to_atom(IpFamilyStr), + case lists:member(IpFamily, [inet, inet6, inet6fb4]) of + true -> + IpFamily; + false -> + throw({error, {bad_ipfamily, IpFamilyStr}}) + end. + + +%%------------------------------------------------------------------------- +%% accept(SocketType, ListenSocket) -> {ok, Socket} | {error, Reason} +%% accept(SocketType, ListenSocket, Timeout) -> ok | {error, Reason} +%% SocketType = ip_comm | {ssl, SSLConfig} +%% ListenSocket = socket() +%% Timeout = infinity | integer() >= 0 +%% Socket = socket() +%% +%% Description: Accepts an incoming connection request on a listen socket, +%% using either gen_tcp or ssl. +%%------------------------------------------------------------------------- +accept(SocketType, ListenSocket) -> + accept(SocketType, ListenSocket, infinity). +accept(ip_comm, ListenSocket, Timeout) -> + gen_tcp:accept(ListenSocket, Timeout); +accept({ssl,_SSLConfig}, ListenSocket, Timeout) -> + ssl:transport_accept(ListenSocket, Timeout). + +%%------------------------------------------------------------------------- +%% controlling_process(SocketType, Socket, NewOwner) -> ok | {error, Reason} +%% SocketType = ip_comm | {ssl, _} +%% Socket = socket() +%% NewOwner = pid() +%% +%% Description: Assigns a new controlling process to Socket. +%%------------------------------------------------------------------------- +controlling_process(ip_comm, Socket, NewOwner) -> + gen_tcp:controlling_process(Socket, NewOwner); +controlling_process({ssl, _}, Socket, NewOwner) -> + ssl:controlling_process(Socket, NewOwner). + +%%------------------------------------------------------------------------- +%% setopts(SocketType, Socket, Options) -> ok | {error, Reason} +%% SocketType = ip_comm | {ssl, _} +%% Socket = socket() +%% Options = list() +%% Description: Sets one or more options for a socket, using either +%% gen_tcp or ssl. +%%------------------------------------------------------------------------- +setopts(ip_comm, Socket, Options) -> + inet:setopts(Socket,Options); +setopts({ssl, _}, Socket, Options) -> + ssl:setopts(Socket, Options). + +%%------------------------------------------------------------------------- +%% send(RequestOrSocketType, Socket, Message) -> ok | {error, Reason} +%% SocketType = ip_comm | {ssl, _} +%% Socket = socket() +%% Message = list() | binary() +%% Description: Sends a packet on a socket, using either gen_tcp or ssl. +%%------------------------------------------------------------------------- +send(ip_comm, Socket, Message) -> + gen_tcp:send(Socket, Message); +send({ssl, _}, Socket, Message) -> + ssl:send(Socket, Message). + +%%------------------------------------------------------------------------- +%% close(SocketType, Socket) -> ok | {error, Reason} +%% SocketType = ip_comm | {ssl, _} +%% Socket = socket() +%% +%% Description: Closes a socket, using either gen_tcp or ssl. +%%------------------------------------------------------------------------- +close(ip_comm, Socket) -> + gen_tcp:close(Socket); +close({ssl, _}, Socket) -> + ssl:close(Socket). + +%%------------------------------------------------------------------------- +%% peername(SocketType, Socket) -> ok | {error, Reason} +%% SocketType = ip_comm | {ssl, _} +%% Socket = socket() +%% +%% Description: Returns the address and port for the other end of a +%% connection, usning either gen_tcp or ssl. +%%------------------------------------------------------------------------- +peername(ip_comm, Socket) -> + case inet:peername(Socket) of + {ok,{{A, B, C, D}, Port}} -> + PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++ + integer_to_list(C)++"."++integer_to_list(D), + {Port, PeerName}; + {ok,{{A, B, C, D, E, F, G, H}, Port}} -> + PeerName = http_util:integer_to_hexlist(A) ++ ":"++ + http_util:integer_to_hexlist(B) ++ ":" ++ + http_util:integer_to_hexlist(C) ++ ":" ++ + http_util:integer_to_hexlist(D) ++ ":" ++ + http_util:integer_to_hexlist(E) ++ ":" ++ + http_util:integer_to_hexlist(F) ++ ":" ++ + http_util:integer_to_hexlist(G) ++":"++ + http_util:integer_to_hexlist(H), + {Port, PeerName}; + {error, _} -> + {-1, "unknown"} + end; + +peername({ssl, _}, Socket) -> + case ssl:peername(Socket) of + {ok,{{A, B, C, D}, Port}} -> + PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++ + integer_to_list(C)++"."++integer_to_list(D), + {Port, PeerName}; + {error, _} -> + {-1, "unknown"} + end. + +%%------------------------------------------------------------------------- +%% resolve() -> HostName +%% HostName = string() +%% +%% Description: Returns the local hostname. +%%------------------------------------------------------------------------- +resolve() -> + {ok, Name} = inet:gethostname(), + Name. + + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%% Address any comes from directive: BindAddress "*" +sock_opt(ip_comm, any = Addr, Opts) -> + sock_opt2([{ip, Addr} | Opts]); +sock_opt(ip_comm, undefined, Opts) -> + sock_opt2(Opts); +sock_opt(_, any = _Addr, Opts) -> + sock_opt2(Opts); +sock_opt(_, undefined = _Addr, Opts) -> + sock_opt2(Opts); +sock_opt(_, {_,_,_,_} = Addr, Opts) -> + sock_opt2([{ip, Addr} | Opts]); +sock_opt(ip_comm, Addr, Opts) -> + sock_opt2([{ip, Addr} | Opts]); +sock_opt(_, Addr, Opts) -> + sock_opt2([{ip, Addr} | Opts]). + +sock_opt2(Opts) -> + [{packet, 0}, {active, false} | Opts]. + +negotiate(ip_comm,_,_) -> + ok; +negotiate({ssl,_},Socket,Timeout) -> + negotiate(Socket, Timeout); +negotiate({erl_ssl, _}, Socket, Timeout) -> + negotiate(Socket, Timeout). + +negotiate(Socket, Timeout) -> + case ssl:ssl_accept(Socket, Timeout) of + ok -> + ok; + {error, Error} -> + case lists:member(Error, + [timeout,econnreset,esslaccept,esslerrssl]) of + true -> + {error,normal}; + false -> + {error, Error} + end + end. diff --git a/lib/inets/src/http_lib/http_util.erl b/lib/inets/src/http_lib/http_util.erl new file mode 100644 index 0000000000..b03b780cf8 --- /dev/null +++ b/lib/inets/src/http_lib/http_util.erl @@ -0,0 +1,148 @@ +%% +%% %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(http_util). + +-export([to_upper/1, to_lower/1, convert_netscapecookie_date/1, + hexlist_to_integer/1, integer_to_hexlist/1, + convert_month/1, is_hostname/1]). + +%%%========================================================================= +%%% Internal application API +%%%========================================================================= +to_upper(Str) -> + string:to_upper(Str). + +to_lower(Str) -> + string:to_lower(Str). + +convert_netscapecookie_date([_D,_A,_Y, $,, _SP, + D1,D2,_DA, + M,O,N,_DA, + Y1,Y2,Y3,Y4,_SP, + H1,H2,_Col, + M1,M2,_Col, + S1,S2|_Rest]) -> + Year=list_to_integer([Y1,Y2,Y3,Y4]), + Day=list_to_integer([D1,D2]), + Month=convert_month([M,O,N]), + Hour=list_to_integer([H1,H2]), + Min=list_to_integer([M1,M2]), + Sec=list_to_integer([S1,S2]), + {{Year,Month,Day},{Hour,Min,Sec}}; + +convert_netscapecookie_date([_D,_A,_Y, _SP, + D1,D2,_DA, + M,O,N,_DA, + Y1,Y2,Y3,Y4,_SP, + H1,H2,_Col, + M1,M2,_Col, + S1,S2|_Rest]) -> + Year=list_to_integer([Y1,Y2,Y3,Y4]), + Day=list_to_integer([D1,D2]), + Month=convert_month([M,O,N]), + Hour=list_to_integer([H1,H2]), + Min=list_to_integer([M1,M2]), + Sec=list_to_integer([S1,S2]), + {{Year,Month,Day},{Hour,Min,Sec}}. + +hexlist_to_integer([])-> + empty; +%%When the string only contains one value its eaasy done. +%% 0-9 +hexlist_to_integer([Size]) when Size >= 48 , Size =< 57 -> + Size - 48; +%% A-F +hexlist_to_integer([Size]) when Size >= 65 , Size =< 70 -> + Size - 55; +%% a-f +hexlist_to_integer([Size]) when Size >= 97 , Size =< 102 -> + Size - 87; +hexlist_to_integer([_Size]) -> + not_a_num; + +hexlist_to_integer(Size) -> + Len = string:span(Size, "1234567890abcdefABCDEF"), + hexlist_to_integer2(Size, 16 bsl (4 *(Len-2)),0). + +integer_to_hexlist(Num)-> + integer_to_hexlist(Num, get_size(Num), []). + +convert_month("Jan") -> 1; +convert_month("Feb") -> 2; +convert_month("Mar") -> 3; +convert_month("Apr") -> 4; +convert_month("May") -> 5; +convert_month("Jun") -> 6; +convert_month("Jul") -> 7; +convert_month("Aug") -> 8; +convert_month("Sep") -> 9; +convert_month("Oct") -> 10; +convert_month("Nov") -> 11; +convert_month("Dec") -> 12. + +is_hostname(Dest) -> + inet_parse:domain(Dest). + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== +hexlist_to_integer2([],_Pos,Sum)-> + Sum; +hexlist_to_integer2([HexVal | HexString], Pos, Sum) + when HexVal >= 48, HexVal =< 57 -> + hexlist_to_integer2(HexString, Pos bsr 4, Sum + ((HexVal-48) * Pos)); + +hexlist_to_integer2([HexVal | HexString], Pos, Sum) + when HexVal >= 65, HexVal =<70 -> + hexlist_to_integer2(HexString, Pos bsr 4, Sum + ((HexVal-55) * Pos)); + +hexlist_to_integer2([HexVal | HexString], Pos, Sum) + when HexVal>=97, HexVal=<102 -> + hexlist_to_integer2(HexString, Pos bsr 4, Sum + ((HexVal-87) * Pos)); + +hexlist_to_integer2(_AfterHexString, _Pos, Sum)-> + Sum. + +integer_to_hexlist(Num, Pot, Res) when Pot<0 -> + convert_to_ascii([Num | Res]); + +integer_to_hexlist(Num,Pot,Res) -> + Position = (16 bsl (Pot*4)), + PosVal = Num div Position, + integer_to_hexlist(Num - (PosVal*Position), Pot-1, [PosVal | Res]). + +get_size(Num)-> + get_size(Num, 0). + +get_size(Num, Pot) when Num < (16 bsl(Pot *4)) -> + Pot-1; + +get_size(Num, Pot) -> + get_size(Num, Pot+1). + +convert_to_ascii(RevesedNum) -> + convert_to_ascii(RevesedNum, []). + +convert_to_ascii([], Num)-> + Num; +convert_to_ascii([Num | Reversed], Number) when Num > -1, Num < 10 -> + convert_to_ascii(Reversed, [Num + 48 | Number]); +convert_to_ascii([Num | Reversed], Number) when Num > 9, Num < 16 -> + convert_to_ascii(Reversed, [Num + 55 | Number]). 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. + diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile new file mode 100644 index 0000000000..2dab99386a --- /dev/null +++ b/lib/inets/src/inets_app/Makefile @@ -0,0 +1,121 @@ +# +# %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 = \ + inets_service \ + inets \ + inets_app \ + inets_sup \ + inets_regexp + +HRL_FILES = inets_internal.hrl + +ERL_FILES = $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \ + $(APP_TARGET) \ + $(APPUP_TARGET) + +APP_FILE = inets.app +APPUP_FILE = inets.appup + +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +APPUP_SRC = $(APPUP_FILE).src +APPUP_TARGET = $(EBIN)/$(APPUP_FILE) + + +# ---------------------------------------------------- +# INETS FLAGS +# ---------------------------------------------------- +INETS_FLAGS = -D'SERVER_SOFTWARE="inets/$(VSN)"' \ + + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_COMPILE_FLAGS += $(INETS_FLAGS) \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,$(APP_VSN)}' + + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core + +docs: + + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: + +info: + @echo "INETS_DEBUG = $(INETS_DEBUG)" + @echo "INETS_FLAGS = $(INETS_FLAGS)" + @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)" diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src new file mode 100644 index 0000000000..6524c3b19b --- /dev/null +++ b/lib/inets/src/inets_app/inets.app.src @@ -0,0 +1,110 @@ +%% This is an -*- erlang -*- file. +%% %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% +%% + +{application,inets, + [{description,"INETS CXC 138 49"}, + {vsn,"%VSN%"}, + {modules,[ + inets, + inets_sup, + inets_app, + inets_service, + inets_regexp, + + %% FTP + ftp, + ftp_progress, + ftp_response, + ftp_sup, + + %% HTTP client: + http, + httpc_handler, + httpc_handler_sup, + httpc_manager, + httpc_profile_sup, + httpc_request, + httpc_response, + httpc_sup, + http_cookie, + + http_uri, %% Proably will by used by server also in the future + + %% HTTP used by both client and server + http_chunk, + http_request, + http_response, + http_transport, + http_util, + + %% HTTP server: + httpd, + httpd_acceptor, + httpd_acceptor_sup, + httpd_cgi, + httpd_conf, + httpd_esi, + httpd_example, + 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_dets, + mod_auth_mnesia, + mod_auth_plain, + mod_auth_server, + mod_browser, + mod_cgi, + mod_dir, + mod_disk_log, + mod_esi, + mod_get, + mod_head, + mod_htaccess, + mod_include, + mod_log, + mod_range, + mod_responsecontrol, + mod_security, + mod_security_server, + mod_trace, + + %% TFTP + tftp, + tftp_binary, + tftp_engine, + tftp_file, + tftp_lib, + tftp_logger, + tftp_sup + ]}, + {registered,[inets_sup, httpc_manager]}, + {applications,[kernel,stdlib]}, + {mod,{inets_app,[]}}]}. diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src new file mode 100644 index 0000000000..59ee1ba03d --- /dev/null +++ b/lib/inets/src/inets_app/inets.appup.src @@ -0,0 +1,50 @@ +%% This is an -*- erlang -*- file. +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-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% + +{"%VSN%", + [ + {"5.1.3", + [ + {load_module, httpd_response, soft_purge, soft_purge, []}, + {update, ftp, {advanced, upgrade_from_pre_5_12}, + soft_purge, soft_purge, []}, + {update, httpc_handler, soft, soft_purge, soft_purge, []} + ] + }, + {"5.1.2", + [ + {restart_application, inets} + ] + } + ], + [ + {"5.1.3", + [ + {load_module, httpd_response, soft_purge, soft_purge, []}, + {update, ftp, {advanced, downgrade_to_pre_5_12}, + soft_purge, soft_purge, []}, + {update, httpc_handler, soft, soft_purge, soft_purge, []} + ] + }, + {"5.1.2", + [ + {restart_application, inets} + ] + } + ] +}. diff --git a/lib/inets/src/inets_app/inets.config b/lib/inets/src/inets_app/inets.config new file mode 100644 index 0000000000..adf0e3ecf1 --- /dev/null +++ b/lib/inets/src/inets_app/inets.config @@ -0,0 +1,2 @@ +[{inets,[{services,[{httpd,"/var/tmp/server_root/conf/8888.conf"}, + {httpd,"/var/tmp/server_root/conf/8080.conf"}]}]}]. diff --git a/lib/inets/src/inets_app/inets.erl b/lib/inets/src/inets_app/inets.erl new file mode 100644 index 0000000000..7977a3dc2a --- /dev/null +++ b/lib/inets/src/inets_app/inets.erl @@ -0,0 +1,740 @@ +%% +%% %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% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: The main interface module of the inets application +%%---------------------------------------------------------------------- + +-module(inets). + +%% API +-export([start/0, start/1, start/2, start/3, + stop/0, stop/2, + services/0, services_info/0, + service_names/0]). +-export([enable_trace/2, enable_trace/3, disable_trace/0, set_trace/1, + report_event/4]). +-export([versions/0, + print_version_info/0, print_version_info/1]). + + +%%==================================================================== +%% API +%%==================================================================== + +%%-------------------------------------------------------------------- +%% Function: start([, Type]) -> ok +%% +%% Type = permanent | transient | temporary +%% +%% Description: Starts the inets application. Default type +%% is temporary. see application(3) +%%-------------------------------------------------------------------- +start() -> + application:start(inets). + +start(Type) -> + application:start(inets, Type). + + +%%-------------------------------------------------------------------- +%% Function: start(Service, ServiceConfig [, How]) -> {ok, Pid} | +%% {error, Reason} +%% +%% Service = - ftpc | tftpd | httpc | httpd +%% ServiceConfig = ConfPropList | ConfFile +%% ConfPropList = [{Property, Value}] according to service +%% ConfFile = Path - when service is httpd +%% How = inets | stand_alone +%% +%% Description: Dynamically starts an inets service after the inets +%% application has been started. +%% +%% Note: Dynamically started services will not be handled by +%% application takeover and failover behavior when inets is run as a +%% distributed application. Nor will they be automaticly restarted +%% when the inets application is restarted, but as long as the inets +%% application is up and running they will be supervised and may be +%% soft code upgraded. Services started with the option stand alone, +%% e.i. the service is not started as part of the inets application, +%% will lose all OTP application benefits such as soft upgrade. The +%% stand alone service will be linked to the process that started it. +%% In most cases some of the supervison functionallity will still be +%% in place and in some sense the calling process has now become the +%% top supervisor. +%% -------------------------------------------------------------------- +start(Service, ServiceConfig) -> + Module = service_module(Service), + start_service(Module, ServiceConfig, inets). + +start(Service, ServiceConfig, How) -> + Module = service_module(Service), + start_service(Module, ServiceConfig, How). + +%%-------------------------------------------------------------------- +%% Function: stop() -> ok +%% +%% Description: Stops the inets application. +%%-------------------------------------------------------------------- +stop() -> + application:stop(inets). + + +%%-------------------------------------------------------------------- +%% Function: stop(Service, Pid) -> ok +%% +%% Service - ftp | tftpd | http | httpd | stand_alone +%% +%% Description: Stops a started service of the inets application or takes +%% down a stand alone "service" gracefully. +%%-------------------------------------------------------------------- +stop(stand_alone, Pid) -> + true = exit(Pid, shutdown), + ok; + +stop(Service, Pid) -> + Module = service_module(Service), + call_service(Module, stop_service, Pid). + + +%%-------------------------------------------------------------------- +%% Function: services() -> [{Service, Pid}] +%% +%% Description: Returns a list of currently running services. +%% Note: Services started with the stand alone option will not be listed +%%-------------------------------------------------------------------- +services() -> + Modules = [service_module(Service) || Service <- + service_names()], + try lists:flatten(lists:map(fun(Module) -> + Module:services() + end, Modules)) of + Result -> + Result + catch + exit:{noproc, _} -> + {error, inets_not_started} + end. + + +%%-------------------------------------------------------------------- +%% Function: services_info() -> [{Service, Pid, Info}] +%% +%% Description: Returns a list of currently running services where +%% each service is described by a [{Property, Value}] list. +%%-------------------------------------------------------------------- +services_info() -> + case services() of + {error, inets_not_started} -> + {error, inets_not_started}; + Services -> + Fun = fun({Service, Pid}) -> + Module = service_module(Service), + Info = + case Module:service_info(Pid) of + {ok, PropList} -> + PropList; + {error, Reason} -> + Reason + end, + {Service, Pid, Info} + end, + lists:flatten(lists:map(Fun, Services)) + end. + + + +%%-------------------------------------------------------------------- +%% Function: print_version_info() +%% +%% Description: Simple utility function to print information +%% about versions (system, OS and modules). +%%-------------------------------------------------------------------- + +print_version_info() -> + {ok, Versions} = inets:versions(), + print_version_info(Versions). + +print_version_info(Versions) when is_list(Versions) -> + print_sys_info(Versions), + print_os_info(Versions), + print_mods_info(Versions). + +print_sys_info(Versions) -> + case key1search(sys_info, Versions) of + {value, SysInfo} when is_list(SysInfo) -> + {value, Arch} = key1search(arch, SysInfo, "Not found"), + {value, Ver} = key1search(ver, SysInfo, "Not found"), + io:format("System info: " + "~n Arch: ~s" + "~n Ver: ~s" + "~n", [Arch, Ver]), + ok; + _ -> + io:format("System info: Not found~n", []), + not_found + end. + +print_os_info(Versions) -> + case key1search(os_info, Versions) of + {value, OsInfo} when is_list(OsInfo) -> + Fam = + case key1search(fam, OsInfo, "Not found") of + {value, F} when is_atom(F) -> + atom_to_list(F); + {value, LF} when is_list(LF) -> + LF; + {value, XF} -> + lists:flatten(io_lib:format("~p", [XF])) + end, + Name = + case key1search(name, OsInfo) of + {value, N} when is_atom(N) -> + "[" ++ atom_to_list(N) ++ "]"; + {value, LN} when is_list(LN) -> + "[" ++ LN ++ "]"; + not_found -> + "" + end, + Ver = + case key1search(ver, OsInfo, "Not found") of + {value, T} when is_tuple(T) -> + tversion(T); + {value, LV} when is_list(LV) -> + LV; + {value, XV} -> + lists:flatten(io_lib:format("~p", [XV])) + end, + io:format("OS info: " + "~n Family: ~s ~s" + "~n Ver: ~s" + "~n", [Fam, Name, Ver]), + ok; + _ -> + io:format("OS info: Not found~n", []), + not_found + end. + +versions() -> + App = inets, + LibDir = code:lib_dir(App), + File = filename:join([LibDir, "ebin", atom_to_list(App) ++ ".app"]), + case file:consult(File) of + {ok, [{application, App, AppFile}]} -> + case lists:keysearch(modules, 1, AppFile) of + {value, {modules, Mods}} -> + {ok, version_info(Mods)}; + _ -> + {error, {invalid_format, modules}} + end; + Error -> + {error, {invalid_format, Error}} + end. + +version_info(Mods) -> + SysInfo = sys_info(), + OsInfo = os_info(), + ModInfo = [mod_version_info(Mod) || Mod <- Mods], + [{sys_info, SysInfo}, {os_info, OsInfo}, {mod_info, ModInfo}]. + +mod_version_info(Mod) -> + Info = Mod:module_info(), + {value, {attributes, Attr}} = lists:keysearch(attributes, 1, Info), + {value, {vsn, [Vsn]}} = lists:keysearch(vsn, 1, Attr), + {value, {app_vsn, AppVsn}} = lists:keysearch(app_vsn, 1, Attr), + {value, {compile, Comp}} = lists:keysearch(compile, 1, Info), + {value, {version, Ver}} = lists:keysearch(version, 1, Comp), + {value, {time, Time}} = lists:keysearch(time, 1, Comp), + {Mod, [{vsn, Vsn}, + {app_vsn, AppVsn}, + {compiler_version, Ver}, + {compile_time, Time}]}. + +sys_info() -> + SysArch = string:strip(erlang:system_info(system_architecture),right,$\n), + SysVer = string:strip(erlang:system_info(system_version),right,$\n), + [{arch, SysArch}, {ver, SysVer}]. + +os_info() -> + V = os:version(), + case os:type() of + {OsFam, OsName} -> + [{fam, OsFam}, {name, OsName}, {ver, V}]; + OsFam -> + [{fam, OsFam}, {ver, V}] + end. + + +print_mods_info(Versions) -> + case key1search(mod_info, Versions) of + {value, ModsInfo} when is_list(ModsInfo) -> + io:format("Module info: ~n", []), + lists:foreach(fun print_mod_info/1, ModsInfo); + _ -> + io:format("Module info: Not found~n", []), + not_found + end. + +tversion(T) -> + L = tuple_to_list(T), + lversion(L). + +lversion([]) -> + ""; +lversion([A]) -> + integer_to_list(A); +lversion([A|R]) -> + integer_to_list(A) ++ "." ++ lversion(R). + +print_mod_info({Module, Info}) -> + % Maybe a asn1 generated module + Asn1Vsn = + case (catch Module:info()) of + AI when is_list(AI) -> + case (catch key1search(vsn, AI)) of + {value, V} when is_atom(V) -> + atom_to_list(V); + _ -> + "-" + end; + _ -> + "-" + end, + Vsn = + case key1search(vsn, Info) of + {value, I} when is_integer(I) -> + integer_to_list(I); + _ -> + "Not found" + end, + AppVsn = + case key1search(app_vsn, Info) of + {value, S1} when is_list(S1) -> + S1; + _ -> + "Not found" + end, + CompVer = + case key1search(compiler_version, Info) of + {value, S2} when is_list(S2) -> + S2; + _ -> + "Not found" + end, + CompDate = + case key1search(compile_time, Info) of + {value, {Year, Month, Day, Hour, Min, Sec}} -> + lists:flatten( + io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", + [Year, Month, Day, Hour, Min, Sec])); + _ -> + "Not found" + end, + io:format(" ~w:~n" + " Vsn: ~s~n" + " App vsn: ~s~n" + " ASN.1 vsn: ~s~n" + " Compiler ver: ~s~n" + " Compile time: ~s~n", + [Module, Vsn, AppVsn, Asn1Vsn, CompVer, CompDate]), + ok. + + +key1search(Key, Vals) -> + case lists:keysearch(Key, 1, Vals) of + {value, {Key, Val}} -> + {value, Val}; + false -> + not_found + end. + +key1search(Key, Vals, Def) -> + case key1search(Key, Vals) of + not_found -> + {value, Def}; + Value -> + Value + end. + + +%%-------------------------------------------------------------------- +%% Function: service_names() -> [ServiceName] +%% +%% ServiceName = atom() +%% +%% Description: Returns a list of supported services +%%------------------------------------------------------------------- +service_names() -> + [ftpc, tftpd, httpc, httpd]. + + +%%----------------------------------------------------------------- +%% enable_trace(Level, Destination) -> void() +%% enable_trace(Level, Destination, Service) -> void() +%% +%% Parameters: +%% Level -> max | min | integer() +%% Destination -> File | Port | io | HandlerSpec +%% Service -> httpc | httpd | ftpc | tftp | all +%% File -> string() +%% Port -> integer() +%% Verbosity -> true | false +%% HandlerSpec = {function(), Data} +%% Data = term() +%% +%% Description: +%% This function is used to start tracing at level Level and send +%% the result either to the file File, the port Port or to a +%% trace handler. +%% Note that it starts a tracer server. +%% When Destination is the atom io (or the tuple {io, Verbosity}), +%% all (printable) inets trace events (trace_ts events which has +%% Severity withing Limit) will be written to stdout using io:format. +%% +%%----------------------------------------------------------------- +enable_trace(Level, Dest) -> + enable_trace(Level, Dest, all). + +enable_trace(Level, Dest, Service) -> + case valid_trace_service(Service) of + true -> + enable_trace2(Level, Dest, Service); + false -> + {error, {invalid_service, Service}} + end. + +enable_trace2(Level, File, Service) + when is_list(File) -> + case file:open(File, [write]) of + {ok, Fd} -> + HandleSpec = {fun handle_trace/2, {Service, Fd}}, + do_enable_trace(Level, process, HandleSpec); + Err -> + Err + end; +enable_trace2(Level, Port, _) when is_integer(Port) -> + do_enable_trace(Level, port, dbg:trace_port(ip, Port)); +enable_trace2(Level, io, Service) -> + HandleSpec = {fun handle_trace/2, {Service, standard_io}}, + do_enable_trace(Level, process, HandleSpec); +enable_trace2(Level, {Fun, _Data} = HandleSpec, _) when is_function(Fun) -> + do_enable_trace(Level, process, HandleSpec). + +do_enable_trace(Level, Type, HandleSpec) -> + case dbg:tracer(Type, HandleSpec) of + {ok, _} -> + set_trace(Level), + ok; + Error -> + Error + end. + +valid_trace_service(all) -> + true; +valid_trace_service(Service) -> + lists:member(Service, [httpc, httpd, ftpc, tftp]). + + +%%----------------------------------------------------------------- +%% disable_trace() -> void() +%% +%% Description: +%% This function is used to stop tracing. +%%----------------------------------------------------------------- +disable_trace() -> + %% This is to make handle_trace/2 close the output file (if the + %% event gets there before dbg closes) + inets:report_event(100, "stop trace", stop_trace, [stop_trace]), + dbg:stop(). + + + +%%----------------------------------------------------------------- +%% set_trace(Level) -> void() +%% +%% Parameters: +%% Level -> max | min | integer() +%% +%% Description: +%% This function is used to change the trace level when tracing has +%% already been started. +%%----------------------------------------------------------------- +set_trace(Level) -> + set_trace(Level, all). + +set_trace(Level, Service) -> + Pat = make_pattern(?MODULE, Service, Level), + change_pattern(Pat). + +make_pattern(Mod, Service, Level) + when is_atom(Mod) andalso is_atom(Service) -> + case Level of + min -> + {Mod, Service, []}; + max -> + Head = ['$1', '_', '_', '_'], + Body = [], + Cond = [], + {Mod, Service, [{Head, Cond, Body}]}; + DetailLevel when is_integer(DetailLevel) -> + Head = ['$1', '_', '_', '_'], + Body = [], + Cond = [{ '=<', '$1', DetailLevel}], + {Mod, Service, [{Head, Cond, Body}]}; + _ -> + exit({bad_level, Level}) + end. + +change_pattern({Mod, Service, Pattern}) + when is_atom(Mod) andalso is_atom(Service) -> + MFA = {Mod, report_event, 4}, + case Pattern of + [] -> + try + error_to_exit(ctp, dbg:ctp(MFA)), + error_to_exit(p, dbg:p(all, clear)) + catch + exit:{Where, Reason} -> + {error, {Where, Reason}} + end; + List when is_list(List) -> + try + error_to_exit(ctp, dbg:ctp(MFA)), + error_to_exit(tp, dbg:tp(MFA, Pattern)), + error_to_exit(p, dbg:p(all, [call, timestamp])) + catch + exit:{Where, Reason} -> + {error, {Where, Reason}} + end; + _ -> + exit({bad_pattern, Pattern}) + end, + ok. + +error_to_exit(_Where, {ok, _} = OK) -> + OK; +error_to_exit(Where, {error, Reason}) -> + exit({Where, Reason}). + + +%%----------------------------------------------------------------- +%% report_event(Serverity, Label, Service, Content) +%% +%% Parameters: +%% Severity -> 0 =< integer() =< 100 +%% Label -> string() +%% Service -> httpd | httpc | ftp | tftp +%% Content -> [{tag, term()}] +%% +%% Description: +%% This function is used to generate trace events, that is, +%% put trace on this function. +%%----------------------------------------------------------------- + +report_event(Severity, Label, Service, Content) + when (is_integer(Severity) andalso + (Severity >= 0) andalso (100 >= Severity)) andalso + is_list(Label) andalso + is_atom(Service) andalso + is_list(Content) -> + hopefully_traced. + + +%% ---------------------------------------------------------------------- +%% handle_trace(Event, Fd) -> Verbosity +%% +%% Parameters: +%% Event -> The trace event (only megaco 'trace_ts' events are printed) +%% Fd -> standard_io | file_descriptor() | trace_port() +%% +%% Description: +%% This function is used to "receive" and print the trace events. +%% Events are printed if: +%% - Verbosity is max +%% - Severity is =< Verbosity (e.g. Severity = 30, and Verbosity = 40) +%% Events are not printed if: +%% - Verbosity is min +%% - Severity is > Verbosity +%%----------------------------------------------------------------- + +handle_trace(_, closed_file = Fd) -> + Fd; +handle_trace({trace_ts, _Who, call, + {?MODULE, report_event, + [_Sev, "stop trace", stop_trace, [stop_trace]]}, + Timestamp}, + {standard_io, _} = Fd) -> + (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + Fd; +handle_trace({trace_ts, _Who, call, + {?MODULE, report_event, + [_Sev, "stop trace", stop_trace, [stop_trace]]}, + Timestamp}, + standard_io = Fd) -> + (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + Fd; +handle_trace({trace_ts, _Who, call, + {?MODULE, report_event, + [_Sev, "stop trace", stop_trace, [stop_trace]]}, + Timestamp}, + {_Service, Fd}) -> + (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch file:close(Fd)), + closed_file; +handle_trace({trace_ts, _Who, call, + {?MODULE, report_event, + [_Sev, "stop trace", stop_trace, [stop_trace]]}, + Timestamp}, + Fd) -> + (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch file:close(Fd)), + closed_file; +handle_trace({trace_ts, Who, call, + {?MODULE, report_event, + [Sev, Label, Service, Content]}, Timestamp}, + Fd) -> + (catch print_inets_trace(Fd, Sev, Timestamp, Who, + Label, Service, Content)), + Fd; +handle_trace(Event, Fd) -> + (catch print_trace(Fd, Event)), + Fd. + + +print_inets_trace({Service, Fd}, + Sev, Timestamp, Who, Label, Service, Content) -> + do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content); +print_inets_trace({ServiceA, Fd}, + Sev, Timestamp, Who, Label, ServiceB, Content) + when (ServiceA =:= all) -> + do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, ServiceB, Content); +print_inets_trace({ServiceA, _Fd}, + _Sev, _Timestamp, _Who, _Label, ServiceB, _Content) + when ServiceA =/= ServiceB -> + ok; +print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content) -> + do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content). + +do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content) -> + Ts = format_timestamp(Timestamp), + io:format(Fd, "[inets ~w trace ~w ~w ~s] ~s " + "~n Content: ~p" + "~n", + [Service, Sev, Who, Ts, Label, Content]). + +print_trace({_, Fd}, Event) -> + do_print_trace(Fd, Event); +print_trace(Fd, Event) -> + do_print_trace(Fd, Event). + +do_print_trace(Fd, {trace, Who, What, Where}) -> + io:format(Fd, "[trace]" + "~n Who: ~p" + "~n What: ~p" + "~n Where: ~p" + "~n", [Who, What, Where]); + +do_print_trace(Fd, {trace, Who, What, Where, Extra}) -> + io:format(Fd, "[trace]" + "~n Who: ~p" + "~n What: ~p" + "~n Where: ~p" + "~n Extra: ~p" + "~n", [Who, What, Where, Extra]); + +do_print_trace(Fd, {trace_ts, Who, What, Where, When}) -> + Ts = format_timestamp(When), + io:format(Fd, "[trace ~s]" + "~n Who: ~p" + "~n What: ~p" + "~n Where: ~p" + "~n", [Ts, Who, What, Where]); + +do_print_trace(Fd, {trace_ts, Who, What, Where, Extra, When}) -> + Ts = format_timestamp(When), + io:format(Fd, "[trace ~s]" + "~n Who: ~p" + "~n What: ~p" + "~n Where: ~p" + "~n Extra: ~p" + "~n", [Ts, Who, What, Where, Extra]); + +do_print_trace(Fd, {seq_trace, What, Where}) -> + io:format(Fd, "[seq trace]" + "~n What: ~p" + "~n Where: ~p" + "~n", [What, Where]); + +do_print_trace(Fd, {seq_trace, What, Where, When}) -> + Ts = format_timestamp(When), + io:format(Fd, "[seq trace ~s]" + "~n What: ~p" + "~n Where: ~p" + "~n", [Ts, What, Where]); + +do_print_trace(Fd, {drop, Num}) -> + io:format(Fd, "[drop trace] ~p~n", [Num]); + +do_print_trace(Fd, Trace) -> + io:format(Fd, "[trace] " + "~n ~p" + "~n", [Trace]). + + +format_timestamp({_N1, _N2, N3} = Now) -> + {Date, Time} = calendar:now_to_datetime(Now), + {YYYY,MM,DD} = Date, + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", + [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), + lists:flatten(FormatDate). + + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +start_service(Service, Args, stand_alone) -> + Service:start_standalone(Args); +start_service(Service, Args, inets) -> + call_service(Service, start_service, Args). + +call_service(Service, Call, Args) -> + try Service:Call(Args) of + Result -> + Result + catch + exit:{noproc, _} -> + {error, inets_not_started} + end. + +service_module(tftpd) -> + tftp; +service_module(httpc) -> + http; +service_module(ftpc) -> + ftp; +service_module(Service) -> + Service. + + + + + + diff --git a/lib/inets/src/inets_app/inets_app.erl b/lib/inets/src/inets_app/inets_app.erl new file mode 100644 index 0000000000..cae79a6767 --- /dev/null +++ b/lib/inets/src/inets_app/inets_app.erl @@ -0,0 +1,30 @@ +%% +%% %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% +%% +%% +-module(inets_app). + +-behaviour(application). + +-export([start/2, stop/1]). + +start(_Type, _State) -> + supervisor:start_link({local, inets_sup}, inets_sup, []). + +stop(_State) -> + ok. diff --git a/lib/inets/src/inets_app/inets_internal.hrl b/lib/inets/src/inets_app/inets_internal.hrl new file mode 100644 index 0000000000..55c3669e4a --- /dev/null +++ b/lib/inets/src/inets_app/inets_internal.hrl @@ -0,0 +1,49 @@ +%% +%% %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% +%% +%% + +-ifndef(inets_internal_hrl). +-define(inets_internal_hrl, true). + +%% Various trace macros + +-define(report(Severity, Label, Service, Content), + inets:report_event(Severity, Label, Service, + [{module, ?MODULE}, {line, ?LINE} | Content])). +-define(report_important(Label, Service, Content), + ?report(20, Label, Service, Content)). +-define(report_verbose(Label, Service, Content), + ?report(40, Label, Service, Content)). +-define(report_debug(Label, Service, Content), + ?report(60, Label, Service, Content)). +-define(report_trace(Label, Service, Content), + ?report(80, Label, Service, Content)). + + +-define(CR, $\r). +-define(LF, $\n). +-define(CRLF, [$\r,$\n]). +-define(SP, $\s). +-define(TAB, $\t). +-define(LEFT_PAREN, $(). +-define(RIGHT_PAREN, $)). +-define(WHITE_SPACE, $ ). +-define(DOUBLE_QUOTE, $"). + +-endif. % -ifdef(inets_internal_hrl). diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl new file mode 100644 index 0000000000..a065533236 --- /dev/null +++ b/lib/inets/src/inets_app/inets_regexp.erl @@ -0,0 +1,413 @@ +%% +%% %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% +%% + +-module(inets_regexp). + +-export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]). + + +%%%========================================================================= +%%% API +%%%========================================================================= + +%% parse(RegExp) -> {ok, RE} | {error, E}. +%% Parse the regexp described in the string RegExp. + +parse(S) -> + case (catch reg(S)) of + {R, []} -> + {ok, R}; + {_R, [C|_]} -> + {error, {illegal, [C]}}; + {error, E} -> + {error, E} + end. + + +%% Find the longest match of RegExp in String. + +match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok,RE} -> match(S, RE); + {error,E} -> {error,E} + end; +match(S, RE) -> + case match(RE, S, 1, 0, -1) of + {Start,Len} when Len >= 0 -> + {match, Start, Len}; + {_Start,_Len} -> + nomatch + end. + +%% Find the first match of RegExp in String. + +first_match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + first_match(S, RE); + {error, E} -> + {error, E} + end; +first_match(S, RE) -> + case first_match(RE, S, 1) of + {Start,Len} when Len >= 0 -> + {match, Start,Len}; + nomatch -> + nomatch + end. + +first_match(RE, S, St) when S =/= [] -> + case re_apply(S, St, RE) of + {match, P, _Rest} -> + {St, P-St}; + nomatch -> + first_match(RE, tl(S), St+1) + end; +first_match(_RE, [], _St) -> + nomatch. + + +match(RE, S, St, Pos, L) -> + case first_match(RE, S, St) of + {St1, L1} -> + Nst = St1 + 1, + if L1 > L -> + match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1); + true -> + match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L) + end; + nomatch -> + {Pos, L} + end. + + +%% Split a string into substrings where the RegExp describes the +%% field seperator. The RegExp " " is specially treated. + +split(String, " ") -> %This is really special + {ok, RE} = parse("[ \t]+"), + case split_apply(String, RE, true) of + [[]|Ss] -> + {ok,Ss}; + Ss -> + {ok,Ss} + end; +split(String, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + {ok, split_apply(String, RE, false)}; + {error, E} -> + {error,E} + end; +split(String, RE) -> + {ok, split_apply(String, RE, false)}. + + +%% Substitute the first match of the regular expression RegExp +%% with the string Replace in String. Accept pre-parsed regular +%% expressions. + +sub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + sub(String, RE, Rep); + {error, E} -> + {error, E} + end; +sub(String, RE, Rep) -> + Ss = sub_match(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%% Substitute every match of the regular expression RegExp with +%% the string New in String. Accept pre-parsed regular expressions. + +gsub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + gsub(String, RE, Rep); + {error, E} -> + {error, E} + end; +gsub(String, RE, Rep) -> + Ss = matches(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%% This is the regular expression grammar used. It is equivalent to the +%% one used in AWK, except that we allow ^ $ to be used anywhere and fail +%% in the matching. +%% +%% reg -> reg1 : '$1'. +%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}. +%% reg1 -> reg2 : '$1'. +%% reg2 -> reg2 reg3 : {concat,'$1','$2'}. +%% reg2 -> reg3 : '$1'. +%% reg3 -> reg3 "*" : {kclosure,'$1'}. +%% reg3 -> reg3 "+" : {pclosure,'$1'}. +%% reg3 -> reg3 "?" : {optional,'$1'}. +%% reg3 -> reg4 : '$1'. +%% reg4 -> "(" reg ")" : '$2'. +%% reg4 -> "\\" char : '$2'. +%% reg4 -> "^" : bos. +%% reg4 -> "$" : eos. +%% reg4 -> "." : char. +%% reg4 -> "[" class "]" : {char_class,char_class('$2')} +%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')} +%% reg4 -> "\"" chars "\"" : char_string('$2') +%% reg4 -> char : '$1'. +%% reg4 -> empty : epsilon. +%% The grammar of the current regular expressions. The actual parser +%% is a recursive descent implementation of the grammar. + +reg(S) -> reg1(S). + +%% reg1 -> reg2 reg1' +%% reg1' -> "|" reg2 +%% reg1' -> empty + +reg1(S0) -> + {L,S1} = reg2(S0), + reg1p(S1, L). + +reg1p([$||S0], L) -> + {R,S1} = reg2(S0), + reg1p(S1, {'or',L,R}); +reg1p(S, L) -> {L,S}. + +%% reg2 -> reg3 reg2' +%% reg2' -> reg3 +%% reg2' -> empty + +reg2(S0) -> + {L,S1} = reg3(S0), + reg2p(S1, L). + +reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) -> + {R,S1} = reg3([C|S0]), + reg2p(S1, {concat,L,R}); +reg2p(S, L) -> {L,S}. + +%% reg3 -> reg4 reg3' +%% reg3' -> "*" reg3' +%% reg3' -> "+" reg3' +%% reg3' -> "?" reg3' +%% reg3' -> empty + +reg3(S0) -> + {L,S1} = reg4(S0), + reg3p(S1, L). + +reg3p([$*|S], L) -> reg3p(S, {kclosure,L}); +reg3p([$+|S], L) -> reg3p(S, {pclosure,L}); +reg3p([$?|S], L) -> reg3p(S, {optional,L}); +reg3p(S, L) -> {L,S}. + +reg4([$(|S0]) -> + case reg(S0) of + {R,[$)|S1]} -> {R,S1}; + {_R,_S} -> throw({error,{unterminated,"("}}) + end; +reg4([$\\,O1,O2,O3|S]) + when ((O1 >= $0) andalso + (O1 =< $7) andalso + (O2 >= $0) andalso + (O2 =< $7) andalso + (O3 >= $0) andalso + (O3 =< $7)) -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +reg4([$\\,C|S]) -> + {escape_char(C),S}; +reg4([$\\]) -> + throw({error, {unterminated,"\\"}}); +reg4([$^|S]) -> + {bos,S}; +reg4([$$|S]) -> + {eos,S}; +reg4([$.|S]) -> + {{comp_class,"\n"},S}; +reg4("[^" ++ S0) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{comp_class,Cc},S1}; + {_Cc,_S} -> throw({error,{unterminated,"["}}) + end; +reg4([$[|S0]) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{char_class,Cc},S1}; + {_Cc,_S1} -> throw({error,{unterminated,"["}}) + end; +reg4([C|S]) + when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) -> + {C, S}; +reg4([C|_S]) -> + throw({error,{illegal,[C]}}); +reg4([]) -> + {epsilon,[]}. + +escape_char($n) -> $\n; %\n = LF +escape_char($r) -> $\r; %\r = CR +escape_char($t) -> $\t; %\t = TAB +escape_char($v) -> $\v; %\v = VT +escape_char($b) -> $\b; %\b = BS +escape_char($f) -> $\f; %\f = FF +escape_char($e) -> $\e; %\e = ESC +escape_char($s) -> $\s; %\s = SPACE +escape_char($d) -> $\d; %\d = DEL +escape_char(C) -> C. + +char_class([$]|S]) -> char_class(S, [$]]); +char_class(S) -> char_class(S, []). + +char($\\, [O1,O2,O3|S]) when + O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +char($\\, [C|S]) -> {escape_char(C),S}; +char(C, S) -> {C,S}. + +char_class([C1|S0], Cc) when C1 =/= $] -> + case char(C1, S0) of + {Cf,[$-,C2|S1]} when C2 =/= $] -> + case char(C2, S1) of + {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); + {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}}) + end; + {C,S1} -> char_class(S1, [C|Cc]) + end; +char_class(S, Cc) -> {Cc,S}. + + +%% re_apply(String, StartPos, RegExp) -> re_app_res(). +%% +%% Apply the (parse of the) regular expression RegExp to String. If +%% there is a match return the position of the remaining string and +%% the string if else return 'nomatch'. BestMatch specifies if we want +%% the longest match, or just a match. +%% +%% StartPos should be the real start position as it is used to decide +%% if we ae at the beginning of the string. +%% +%% Pass two functions to re_apply_or so it can decide, on the basis +%% of BestMatch, whether to just any take any match or try both to +%% find the longest. This is slower but saves duplicatng code. + +re_apply(S, St, RE) -> re_apply(RE, [], S, St). + +re_apply(epsilon, More, S, P) -> %This always matches + re_apply_more(More, S, P); +re_apply({'or',RE1,RE2}, More, S, P) -> + re_apply_or(re_apply(RE1, More, S, P), + re_apply(RE2, More, S, P)); +re_apply({concat,RE1,RE2}, More, S0, P) -> + re_apply(RE1, [RE2|More], S0, P); +re_apply({kclosure,CE}, More, S, P) -> + %% Be careful with the recursion, explicitly do one call before + %% looping. + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, [{kclosure,CE}|More], S, P)); +re_apply({pclosure,CE}, More, S, P) -> + re_apply(CE, [{kclosure,CE}|More], S, P); +re_apply({optional,CE}, More, S, P) -> + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, More, S, P)); +re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1); +re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P); +re_apply(eos, More, [], P) -> re_apply_more(More, [], P); +re_apply({char_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> re_apply_more(More, S, P+1); + false -> nomatch + end; +re_apply({comp_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> nomatch; + false -> re_apply_more(More, S, P+1) + end; +re_apply(C, More, [C|S], P) when is_integer(C) -> + re_apply_more(More, S, P+1); +re_apply(_RE, _More, _S, _P) -> nomatch. + +%% re_apply_more([RegExp], String, Length) -> re_app_res(). + +re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P); +re_apply_more([], S, P) -> {match,P,S}. + +%% in_char_class(Char, Class) -> bool(). + +in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true; +in_char_class(C, [C|_Cc]) -> true; +in_char_class(C, [_|Cc]) -> in_char_class(C, Cc); +in_char_class(_C, []) -> false. + +%% re_apply_or(Match1, Match2) -> re_app_res(). +%% If we want the best match then choose the longest match, else just +%% choose one by trying sequentially. + +re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1}; +re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2}; +re_apply_or(nomatch, R2) -> R2; +re_apply_or(R1, nomatch) -> R1. + + +matches(S, RE, St) -> + case first_match(RE, S, St) of + {St1,0} -> + [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)]; + {St1,L1} -> + [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)]; + nomatch -> + [] + end. + +sub_match(S, RE, St) -> + case first_match(RE, S, St) of + {St1,L1} -> [{St1,L1}]; + nomatch -> [] + end. + +sub_repl([{St,L}|Ss], Rep, S, Pos) -> + Rs = sub_repl(Ss, Rep, S, St+L), + string:substr(S, Pos, St-Pos) ++ + sub_repl(Rep, string:substr(S, St, L), Rs); +sub_repl([], _Rep, S, Pos) -> + string:substr(S, Pos). + +sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest); +sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)]; +sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)]; +sub_repl([], _M, Rest) -> Rest. + +split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []). + +split_apply([], _P, _RE, true, []) -> + []; +split_apply([], _P, _RE, _T, Sub) -> + [lists:reverse(Sub)]; +split_apply(S, P, RE, T, Sub) -> + case re_apply(S, P, RE) of + {match,P,_Rest} -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]); + {match,P1,Rest} -> + [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])]; + nomatch -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]) + end. diff --git a/lib/inets/src/inets_app/inets_service.erl b/lib/inets/src/inets_app/inets_service.erl new file mode 100644 index 0000000000..3499314d54 --- /dev/null +++ b/lib/inets/src/inets_app/inets_service.erl @@ -0,0 +1,65 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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(inets_service). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{start_standalone, 1}, + {start_service, 1}, + {stop_service, 1}, + {services, 0}, + {service_info, 1}]; +behaviour_info(_) -> + undefined. + +%% Starts service stand-alone +%% start_standalone(Config) -> % {ok, Pid} | {error, Reason} +%% <service>:start_link(Config). + +%% Starts service as part of inets +%% start_service(Config) -> % {ok, Pid} | {error, Reason} +%% <service_sup>:start_child(Config). +%% Stop service +%% stop_service(Pid) -> % ok | {error, Reason} +%% <service_sup>:stop_child(maybe_map_pid_to_other_ref(Pid)). +%% +%% <service_sup>:stop_child(Ref) -> +%% Id = id(Ref), +%% case supervisor:terminate_child(?MODULE, Id) of +%% ok -> +%% supervisor:delete_child(?MODULE, Id); +%% Error -> +%% Error +%% end. + +%% Returns list of running services. Services started as stand alone +%% are not listed +%% services() -> % [{Service, Pid}] +%% Exampel: +%% services() -> +%% [{httpc, Pid} || {_, Pid, _, _} <- +%% supervisor:which_children(httpc_profile_sup)]. + + +%% service_info() -> [{Property, Value}] | {error, Reason} +%% ex: http:service_info() -> [{profile, ProfileName}] +%% httpd:service_info() -> [{host, Host}, {port, Port}] diff --git a/lib/inets/src/inets_app/inets_sup.erl b/lib/inets/src/inets_app/inets_sup.erl new file mode 100644 index 0000000000..20d5ef343e --- /dev/null +++ b/lib/inets/src/inets_app/inets_sup.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% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: The top supervisor for the inets application +%%---------------------------------------------------------------------- + +-module(inets_sup). + +-behaviour(supervisor). + +-export([init/1]). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init([]) -> + SupFlags = {one_for_one, 10, 3600}, + Children = children(), + {ok, {SupFlags, Children}}. + +%%%========================================================================= +%%% Internal functions +%%%========================================================================= +get_services() -> + case (catch application:get_env(inets, services)) of + {ok, Services} -> + Services; + _ -> + [] + end. + +children() -> + Services = get_services(), + HttpdServices = [Service || Service <- Services, is_httpd(Service)], + HttpcServices = [Service || Service <- Services, is_httpc(Service)], + TftpdServices = [Service || Service <- Services, is_tftpd(Service)], + [ftp_child_spec(), httpc_child_spec(HttpcServices), + httpd_child_spec(HttpdServices), tftpd_child_spec(TftpdServices)]. + +ftp_child_spec() -> + Name = ftp_sup, + StartFunc = {ftp_sup, start_link, []}, + Restart = permanent, + Shutdown = infinity, + Modules = [ftp_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + + +httpc_child_spec(HttpcServices0) -> + HttpcServices = default_profile(HttpcServices0, []), + Name = httpc_sup, + StartFunc = {httpc_sup, start_link, [HttpcServices]}, + Restart = permanent, + Shutdown = infinity, + Modules = [httpc_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +httpd_child_spec(HttpdServices) -> + Name = httpd_sup, + StartFunc = {httpd_sup, start_link, [HttpdServices]}, + Restart = permanent, + Shutdown = infinity, + Modules = [httpd_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +tftpd_child_spec(TftpServices) -> + Name = tftp_sup, + StartFunc = {tftp_sup, start_link, [TftpServices]}, + Restart = permanent, + Shutdown = infinity, + Modules = [tftp_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +is_httpd({httpd, _}) -> + true; +is_httpd({httpd, _, _}) -> + true; +is_httpd(_) -> + false. + +is_httpc({httpc, _}) -> + true; +is_httpc(_) -> + false. + +is_tftpd({tftpd, _}) -> + true; +is_tftpd(_) -> + false. + +default_profile([], Acc) -> + [{httpc, {default, only_session_cookies}} | Acc]; +default_profile([{httpc, {default, _}} | _] = Profiles, Acc) -> + Profiles ++ Acc; +default_profile([Profile | Profiles], Acc) -> + default_profile(Profiles, [Profile | Acc]). diff --git a/lib/inets/src/subdirs.mk b/lib/inets/src/subdirs.mk new file mode 100644 index 0000000000..9f2a0079f2 --- /dev/null +++ b/lib/inets/src/subdirs.mk @@ -0,0 +1,3 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +SUB_DIRECTORIES = inets_app http_lib http_client http_server ftp tftp diff --git a/lib/inets/src/tftp/Makefile b/lib/inets/src/tftp/Makefile new file mode 100644 index 0000000000..63f70f7943 --- /dev/null +++ b/lib/inets/src/tftp/Makefile @@ -0,0 +1,95 @@ +# +# %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 = \ + tftp \ + tftp_binary \ + tftp_engine \ + tftp_file \ + tftp_lib \ + tftp_logger \ + tftp_sup + +HRL_FILES = tftp.hrl + +ERL_FILES = $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# INETS FLAGS +# ---------------------------------------------------- +INETS_FLAGS = -D'SERVER_SOFTWARE="inets/$(VSN)"' \ + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += $(INETS_FLAGS) \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,$(APP_VSN)}' +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core + +docs: + +# ---------------------------------------------------- +# 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/tftp/tftp.erl b/lib/inets/src/tftp/tftp.erl new file mode 100644 index 0000000000..bfdb4c0030 --- /dev/null +++ b/lib/inets/src/tftp/tftp.erl @@ -0,0 +1,362 @@ +%% +%% %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% +%% +%% + +%%%------------------------------------------------------------------- +%%% File : tftp.erl +%%% Author : Hakan Mattsson <[email protected]> +%%% Description : Trivial FTP +%%% Created : 18 May 2004 by Hakan Mattsson <[email protected]> +%%%------------------------------------------------------------------- +%%% +%%% This is a complete implementation of the following IETF standards: +%%% +%%% RFC 1350, The TFTP Protocol (revision 2). +%%% RFC 2347, TFTP Option Extension. +%%% RFC 2348, TFTP Blocksize Option. +%%% RFC 2349, TFTP Timeout Interval and Transfer Size Options. +%%% +%%% The only feature that not is implemented in this release is +%%% the "netascii" transfer mode. +%%% +%%% The start/1 function starts a daemon process which, listens for +%%% UDP packets on a port. When it receives a request for read or +%%% write it spawns a temporary server process which handles the +%%% actual transfer of the file. On the client side the read_file/3 +%%% and write_file/3 functions spawns a temporary client process which +%%% establishes contact with a TFTP daemon and performs the actual +%%% transfer of the file. +%%% +%%% Most of the options are common for both the client and the server +%%% side, but some of them differs a little. Here are the available +%%% options: +%%% +%%% {debug, Level} +%%% +%%% Level = none | error | warning brief | normal | verbose | all +%%% +%%% Controls the level of debug printouts. The default is none. +%%% +%%% {host, Host} +%%% +%%% The name or IP address of the host where the TFTP daemon +%%% resides. This option is only used by the client. See +%%% 'inet' about valid host names. +%%% +%%% {port, Port} +%%% +%%% Port = integer() +%%% +%%% The TFTP port where the daemon listens. It defaults to the +%%% standardized number 69. On the server side it may sometimes +%%% make sense to set it to 0, which means that the daemon just +%%% will pick a free port (which is returned by the start/1 +%%% function). +%%% +%%% If a socket has somehow already has been connected, the +%%% {udp, [{fd, integer()}]} option can be used to pass the +%%% open file descriptor to gen_udp. This can be automated +%%% a bit by using a command line argument stating the +%%% prebound file descriptor number. For example, if the +%%% Port is 69 and the file descriptor 22 has been opened by +%%% setuid_socket_wrap. Then the command line argument +%%% "-tftpd_69 22" will trigger the prebound file +%%% descriptor 22 to be used instead of opening port 69. +%%% The UDP option {udp, [{fd, 22}]} autmatically be added. +%%% See init:get_argument/ about command line arguments and +%%% gen_udp:open/2 about UDP options. +%%% +%%% {port_policy, Policy} +%%% +%%% Policy = random | Port | {range, MinPort, MaxPort} +%%% Port = MinPort = MaxPort = integer() +%%% +%%% Policy for the selection of the temporary port which is used +%%% by the server/client during the file transfer. It defaults to +%%% 'random' which is the standardized policy. With this policy a +%%% randomized free port used. A single port or a range of ports +%%% can be useful if the protocol should pass thru a firewall. +%%% +%%% {prebound_fd, InitArgFlag} +%%% +%%% InitArgFlag = atom() +%%% +%%% If a socket has somehow already has been connected, the +%%% {udp, [{fd, integer()}]} option can be used to pass the +%%% open file descriptor to gen_udp. +%%% +%%% The prebound_fd option makes it possible to pass give the +%%% file descriptor as a command line argument. The typical +%%% usage is when used in conjunction with setuid_socket_wrap +%%% to be able to open privileged sockets. For example if the +%%% file descriptor 22 has been opened by setuid_socket_wrap +%%% and you have choosen my_tftp_fd as init argument, the +%%% command line should like this "erl -my_tftp_fd 22" and +%%% FileDesc should be set to my_tftpd_fd. This would +%%% automatically imply {fd, 22} to be set as UDP option. +%%% +%%% {udp, UdpOptions} +%%% +%%% Options to gen_udp:open/2. +%%% +%%% {use_tsize, Bool} +%%% +%%% Bool = boolean() +%%% +%%% Flag for automated usage of the "tsize" option. With this set +%%% to true, the write_file/3 client will determine the filesize +%%% and send it to the server as the standardized "tsize" option. +%%% A read_file/3 client will just acquire filesize from the +%%% server by sending a zero "tsize". +%%% +%%% {max_tsize, MaxTsize} +%%% +%%% MaxTsize = integer() | infinity +%%% +%%% Threshold for the maximal filesize in bytes. The transfer will +%%% be aborted if the limit is exceeded. It defaults to +%%% 'infinity'. +%%% +%%% {max_conn, MaxConn} +%%% +%%% MaxConn = integer() | infinity +%%% +%%% Threshold for the maximal number of active connections. The +%%% daemon will reject the setup of new connections if the limit +%%% is exceeded. It defaults to 'infinity'. +%%% +%%% {TftpKey, TftpVal} +%%% +%%% TftpKey = string() +%%% TftpVal = string() +%%% +%%% The name and value of a TFTP option. +%%% +%%% {reject, Feature} +%%% +%%% Feature = Mode | TftpKey +%%% Mode = read | write +%%% TftpKey = string() +%%% +%%% Control which features that should be rejected. +%%% This is mostly useful for the server as it may restrict +%%% usage of certain TFTP options or read/write access. +%%% +%%% {callback, {RegExp, Module, State}} +%%% +%%% RegExp = string() +%%% Module = atom() +%%% State = term() +%%% +%%% Registration of a callback module. When a file is to be +%%% transferred, its local filename will be matched to the +%%% regular expressions of the registered callbacks. The first +%%% matching callback will be used the during the transfer.The +%%% callback module must implement the 'tftp' behaviour. +%%% +%%% On the server side the callback interaction starts with a +%%% call to open/5 with the registered initial callback +%%% state. open/5 is expected to open the (virtual) file. Then +%%% either the read/1 or write/2 functions are invoked +%%% repeatedly, once per transfererred block. At each function +%%% call the state returned from the previous call is +%%% obtained. When the last block has been encountered the read/1 +%%% or write/2 functions is expected to close the (virtual) +%%% file.and return its last state. The abort/3 function is only +%%% used in error situations. prepare/5 is not used on the server +%%% side. +%%% +%%% On the client side the callback interaction is the same, but +%%% it starts and ends a bit differently. It starts with a call +%%% to prepare/5 with the same arguments as open/5 +%%% takes. prepare/5 is expected to validate the TFTP options, +%%% suggested by the user and return the subset of them that it +%%% accepts. Then the options is sent to the server which will +%%% perform the same TFTP option negotiation procedure. The +%%% options that are accepted by the server is forwarded to the +%%% open/5 function on the client side. On the client side the +%%% open/5 function must accept all option as is or reject the +%%% transfer. Then the callback interaction follows the same +%%% pattern as described above for the server side. When the last +%%% block is encountered in read/1 or write/2 the returned stated +%%% is forwarded to the user and returned from read_file/3 or +%%% write_file/3. +%%%------------------------------------------------------------------- + +-module(tftp). + +%%------------------------------------------------------------------- +%% Interface +%%------------------------------------------------------------------- + +%% Public functions +-export([ + read_file/3, + write_file/3, + start/1, + info/1, + change_config/2, + start/0 + ]). + +-export([behaviour_info/1]). + +%% Application local functions +-export([ + start_standalone/1, + start_service/1, + stop_service/1, + services/0, + service_info/1 + ]). + + +behaviour_info(callbacks) -> + [{prepare, 6}, {open, 6}, {read, 1}, {write, 2}, {abort, 3}]; +behaviour_info(_) -> + undefined. + +-include("tftp.hrl"). + +%%------------------------------------------------------------------- +%% read_file(RemoteFilename, LocalFilename, Options) -> +%% {ok, LastCallbackState} | {error, Reason} +%% +%% RemoteFilename = string() +%% LocalFilename = binary | string() +%% Options = [option()] +%% LastCallbackState = term() +%% Reason = term() +%% +%% Reads a (virtual) file from a TFTP server +%% +%% If LocalFilename is the atom 'binary', tftp_binary will be used as +%% callback module. It will concatenate all transferred blocks and +%% return them as one single binary in the CallbackState. +%% +%% When LocalFilename is a string, it will be matched to the +%% registered callback modules and hopefully one of them will be +%% selected. By default, tftp_file will be used as callback module. It +%% will write each transferred block to the file named +%% LocalFilename. The number of transferred bytes will be returned as +%% LastCallbackState. +%%------------------------------------------------------------------- + +read_file(RemoteFilename, LocalFilename, Options) -> + tftp_engine:client_start(read, RemoteFilename, LocalFilename, Options). + +%%------------------------------------------------------------------- +%% write(RemoteFilename, LocalFilename, Options) -> +%% {ok, LastCallbackState} | {error, Reason} +%% +%% RemoteFilename = string() +%% LocalFilename = binary() | string() +%% Options = [option()] +%% LastCallbackState = term() +%% Reason = term() +%% +%% Writes a (virtual) file to a TFTP server +%% +%% If LocalFilename is a binary, tftp_binary will be used as callback +%% module. The binary will be transferred block by block and the number +%% of transferred bytes will be returned as LastCallbackState. +%% +%% When LocalFilename is a string, it will be matched to the +%% registered callback modules and hopefully one of them will be +%% selected. By default, tftp_file will be used as callback module. It +%% will read the file named LocalFilename block by block. The number +%% of transferred bytes will be returned as LastCallbackState. +%%------------------------------------------------------------------- + +write_file(RemoteFilename, LocalFilename, Options) -> + tftp_engine:client_start(write, RemoteFilename, LocalFilename, Options). + +%%------------------------------------------------------------------- +%% start(Options) -> {ok, Pid} | {error, Reason} +%% +%% Options = [option()] +%% Pid = pid() +%% Reason = term() +%% +%% Starts a daemon process which listens for udp packets on a +%% port. When it receives a request for read or write it spawns +%% a temporary server process which handles the actual transfer +%% of the (virtual) file. +%%------------------------------------------------------------------- + +start(Options) -> + tftp_engine:daemon_start(Options). + +%%------------------------------------------------------------------- +%% info(Pid) -> {ok, Options} | {error, Reason} +%% +%% Options = [option()] +%% Reason = term() +%% +%% Returns info about a tftp daemon, server or client process +%%------------------------------------------------------------------- + +info(Pid) -> + tftp_engine:info(Pid). + +%%------------------------------------------------------------------- +%% change_config(Pid, Options) -> ok | {error, Reason} +%% +%% Options = [option()] +%% Reason = term() +%% +%% Changes config for a tftp daemon, server or client process +%% Must be used with care. +%%------------------------------------------------------------------- + +change_config(Pid, Options) -> + tftp_engine:change_config(Pid, Options). + +%%------------------------------------------------------------------- +%% start() -> ok | {error, Reason} +%% +%% Reason = term() +%% +%% Start the application +%%------------------------------------------------------------------- + +start() -> + application:start(inets). + +%%------------------------------------------------------------------- +%% Inets service behavior +%%------------------------------------------------------------------- + +start_standalone(Options) -> + start(Options). + +start_service(Options) -> + tftp_sup:start_child(Options). + +stop_service(Pid) -> + tftp_sup:stop_child(Pid). + +services() -> + tftp_sup:which_children(). + +service_info(Pid) -> + info(Pid). + + + diff --git a/lib/inets/src/tftp/tftp.hrl b/lib/inets/src/tftp/tftp.hrl new file mode 100644 index 0000000000..6846b07690 --- /dev/null +++ b/lib/inets/src/tftp/tftp.hrl @@ -0,0 +1,68 @@ +%% +%% %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% +%% +%% + +%%%------------------------------------------------------------------- +%%% Defines +%%%------------------------------------------------------------------- + +-define(TFTP_DEFAULT_PORT, 69).% Default server port + +-define(TFTP_OPCODE_RRQ, 1). % Read request +-define(TFTP_OPCODE_WRQ, 2). % Write request +-define(TFTP_OPCODE_DATA, 3). % Data +-define(TFTP_OPCODE_ACK, 4). % Acknowledgement +-define(TFTP_OPCODE_ERROR, 5). % Error +-define(TFTP_OPCODE_OACK, 6). % Option acknowledgment + +-define(TFTP_ERROR_UNDEF, 0). % Not defined, see error message (if any) +-define(TFTP_ERROR_ENOENT, 1). % File not found. +-define(TFTP_ERROR_EACCES, 2). % Access violation. +-define(TFTP_ERROR_ENOSPC, 3). % Disk full or allocation exceeded. +-define(TFTP_ERROR_BADOP, 4). % Illegal TFTP operation. +-define(TFTP_ERROR_BADBLK, 5). % Unknown transfer ID. +-define(TFTP_ERROR_EEXIST, 6). % File already exists. +-define(TFTP_ERROR_BADUSER, 7). % No such user. +-define(TFTP_ERROR_BADOPT, 8). % Unrequested or illegal option. + +-record(tftp_msg_req, {access, filename, mode, options, local_filename}). +-record(tftp_msg_data, {block_no, data}). +-record(tftp_msg_ack, {block_no}). +-record(tftp_msg_error, {code, text, details}). +-record(tftp_msg_oack, {options}). + +-record(config, {parent_pid = self(), + udp_socket, + udp_options = [binary, {reuseaddr, true}, {active, once}], + udp_host = "localhost", + udp_port = ?TFTP_DEFAULT_PORT, + port_policy = random, + use_tsize = false, + max_tsize = infinity, % Filesize + max_conn = infinity, + rejected = [], + polite_ack = false, + debug_level = none, + timeout, + user_options = [], + callbacks = [], + logger = tftp_logger, + max_retries = 5}). + +-record(callback, {regexp, internal, module, state, block_no, count}). diff --git a/lib/inets/src/tftp/tftp_binary.erl b/lib/inets/src/tftp/tftp_binary.erl new file mode 100644 index 0000000000..9efa79105d --- /dev/null +++ b/lib/inets/src/tftp/tftp_binary.erl @@ -0,0 +1,238 @@ +%% +%% %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% +%% +%% + +%%%------------------------------------------------------------------- +%%% File : tft_binary.erl +%%% Author : Hakan Mattsson <[email protected]> +%%% Description : +%%% +%%% Created : 24 May 2004 by Hakan Mattsson <[email protected]> +%%%------------------------------------------------------------------- + +-module(tftp_binary). + +%%%------------------------------------------------------------------- +%%% Interface +%%%------------------------------------------------------------------- + +-behaviour(tftp). + +-export([prepare/6, open/6, read/1, write/2, abort/3]). + +-record(read_state, {options, blksize, bin, is_native_ascii, is_network_ascii, count}). +-record(write_state, {options, blksize, list, is_native_ascii, is_network_ascii}). + +%%------------------------------------------------------------------- +%% Prepare +%%------------------------------------------------------------------- + +prepare(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) -> + %% Client side + IsNativeAscii = is_native_ascii(Initial), + case catch handle_options(Access, Filename, Mode, SuggestedOptions, IsNativeAscii) of + {ok, IsNetworkAscii, AcceptedOptions} when Access =:= read, is_binary(Filename) -> + State = #read_state{options = AcceptedOptions, + blksize = lookup_blksize(AcceptedOptions), + bin = Filename, + is_network_ascii = IsNetworkAscii, + count = size(Filename), + is_native_ascii = IsNativeAscii}, + {ok, AcceptedOptions, State}; + {ok, IsNetworkAscii, AcceptedOptions} when Access =:= write, Filename =:= binary -> + State = #write_state{options = AcceptedOptions, + blksize = lookup_blksize(AcceptedOptions), + list = [], + is_network_ascii = IsNetworkAscii, + is_native_ascii = IsNativeAscii}, + {ok, AcceptedOptions, State}; + {ok, _, _} -> + {error, {undef, "Illegal callback usage. Mode and filename is incompatible."}}; + {error, {Code, Text}} -> + {error, {Code, Text}} + end; +prepare(_Peer, _Access, _Bin, _Mode, _SuggestedOptions, _Initial) -> + {error, {undef, "Illegal callback options."}}. + +%%------------------------------------------------------------------- +%% Open +%%------------------------------------------------------------------- + +open(Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) -> + %% Server side + case prepare(Peer, Access, Filename, Mode, SuggestedOptions, Initial) of + {ok, AcceptedOptions, State} -> + open(Peer, Access, Filename, Mode, AcceptedOptions, State); + {error, {Code, Text}} -> + {error, {Code, Text}} + end; +open(_Peer, Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, read_state) -> + %% Both sides + case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State#read_state.is_native_ascii) of + {ok, IsNetworkAscii, Options} + when Options =:= NegotiatedOptions, + IsNetworkAscii =:= State#read_state.is_network_ascii -> + {ok, NegotiatedOptions, State}; + {error, {Code, Text}} -> + {error, {Code, Text}} + end; +open(_Peer, Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, write_state) -> + %% Both sides + case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State#write_state.is_native_ascii) of + {ok, IsNetworkAscii, Options} + when Options =:= NegotiatedOptions, + IsNetworkAscii =:= State#write_state.is_network_ascii -> + {ok, NegotiatedOptions, State}; + {error, {Code, Text}} -> + {error, {Code, Text}} + end; +open(Peer, Access, Filename, Mode, NegotiatedOptions, State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + State2 = upgrade_state(State), + open(Peer, Access, Filename, Mode, NegotiatedOptions, State2). + +%%------------------------------------------------------------------- +%% Read +%%------------------------------------------------------------------- + +read(#read_state{bin = Bin} = State) when is_binary(Bin) -> + BlkSize = State#read_state.blksize, + if + size(Bin) >= BlkSize -> + <<Block:BlkSize/binary, Bin2/binary>> = Bin, + State2 = State#read_state{bin = Bin2}, + {more, Block, State2}; + size(Bin) < BlkSize -> + {last, Bin, State#read_state.count} + end; +read(State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + State2 = upgrade_state(State), + read(State2). + +%%------------------------------------------------------------------- +%% Write +%%------------------------------------------------------------------- + +write(Bin, #write_state{list = List} = State) when is_binary(Bin), is_list(List) -> + Size = size(Bin), + BlkSize = State#write_state.blksize, + if + Size =:= BlkSize -> + {more, State#write_state{list = [Bin | List]}}; + Size < BlkSize -> + Bin2 = list_to_binary(lists:reverse([Bin | List])), + {last, Bin2} + end; +write(Bin, State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + State2 = upgrade_state(State), + write(Bin, State2). + +%%------------------------------------------------------------------- +%% Abort +%%------------------------------------------------------------------- + +abort(_Code, _Text, #read_state{bin = Bin} = State) + when is_record(State, read_state), is_binary(Bin) -> + ok; +abort(_Code, _Text, #write_state{list = List} = State) + when is_record(State, write_state), is_list(List) -> + ok; +abort(Code, Text, State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + State2 = upgrade_state(State), + abort(Code, Text, State2). + +%%------------------------------------------------------------------- +%% Process options +%%------------------------------------------------------------------- + +handle_options(Access, Bin, Mode, Options, IsNativeAscii) -> + IsNetworkAscii = handle_mode(Mode, IsNativeAscii), + Options2 = do_handle_options(Access, Bin, Options), + {ok, IsNetworkAscii, Options2}. + +handle_mode(Mode, IsNativeAscii) -> + case Mode of + "netascii" when IsNativeAscii =:= true -> true; + "octet" -> false; + _ -> throw({error, {badop, "Illegal mode " ++ Mode}}) + end. + +do_handle_options(Access, Bin, [{Key, Val} | T]) -> + case Key of + "tsize" -> + case Access of + read when Val =:= "0", is_binary(Bin) -> + Tsize = integer_to_list(size(Bin)), + [{Key, Tsize} | do_handle_options(Access, Bin, T)]; + _ -> + handle_integer(Access, Bin, Key, Val, T, 0, infinity) + end; + "blksize" -> + handle_integer(Access, Bin, Key, Val, T, 8, 65464); + "timeout" -> + handle_integer(Access, Bin, Key, Val, T, 1, 255); + _ -> + do_handle_options(Access, Bin, T) + end; +do_handle_options(_Access, _Bin, []) -> + []. + + +handle_integer(Access, Bin, Key, Val, Options, Min, Max) -> + case catch list_to_integer(Val) of + {'EXIT', _} -> + do_handle_options(Access, Bin, Options); + Int when Int >= Min, Int =< Max -> + [{Key, Val} | do_handle_options(Access, Bin, Options)]; + Int when Int >= Min, Max =:= infinity -> + [{Key, Val} | do_handle_options(Access, Bin, Options)]; + _Int -> + throw({error, {badopt, "Illegal " ++ Key ++ " value " ++ Val}}) + end. + +lookup_blksize(Options) -> + case lists:keysearch("blksize", 1, Options) of + {value, {_, Val}} -> + list_to_integer(Val); + false -> + 512 + end. + +is_native_ascii([]) -> + is_native_ascii(); +is_native_ascii([{native_ascii, Bool}]) -> + case Bool of + true -> true; + false -> false + end. + +is_native_ascii() -> + case os:type() of + {win32, _} -> true; + _ -> false + end. + +%% Handle upgrade from old releases. Please, remove this function in next release. +upgrade_state({read_state, Options, Blksize, Bin, IsNetworkAscii, Count}) -> + {read_state, Options, Blksize, Bin, false, IsNetworkAscii, Count}; +upgrade_state({write_state, Options, Blksize, List, IsNetworkAscii}) -> + {write_state, Options, Blksize, List, false, IsNetworkAscii}. diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl new file mode 100644 index 0000000000..81c53bbe40 --- /dev/null +++ b/lib/inets/src/tftp/tftp_engine.erl @@ -0,0 +1,1442 @@ +%% +%% %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% +%% +%%------------------------------------------------------------------- +%% Protocol engine for trivial FTP +%%------------------------------------------------------------------- + +-module(tftp_engine). + +%%%------------------------------------------------------------------- +%%% Interface +%%%------------------------------------------------------------------- + +%% application internal functions +-export([ + daemon_start/1, + daemon_loop/1, + daemon_loop/3, %% Handle upgrade from old releases. Please, remove this function in next release. + client_start/4, + common_loop/6, + info/1, + change_config/2 + ]). + +%% module internal +-export([ + daemon_init/1, + server_init/2, + client_init/2, + wait_for_msg/3, + callback/4 + ]). + +%% sys callback functions +-export([ + system_continue/3, + system_terminate/4, + system_code_change/4 + ]). + +-include("tftp.hrl"). + +-type prep_status() :: 'error' | 'last' | 'more' | 'terminate'. + +-record(daemon_state, {config, n_servers, server_tab, file_tab}). +-record(server_info, {pid, req, peer}). +-record(file_info, {peer_req, pid}). +-record(sys_misc, {module, function, arguments}). +-record(error, {where, code, text, filename}). +-record(prepared, {status :: prep_status(), result, block_no, next_data, prev_data}). +-record(transfer_res, {status, decoded_msg, prepared}). +-define(ERROR(Where, Code, Text, Filename), + #error{where = Where, code = Code, text = Text, filename = Filename}). + +%%%------------------------------------------------------------------- +%%% Info +%%%------------------------------------------------------------------- + +info(daemons) -> + Daemons = supervisor:which_children(tftp_sup), + [{Pid, info(Pid)} || {_, Pid, _, _} <- Daemons]; +info(servers) -> + [{Pid, info(Pid)} || {_, {ok, DeamonInfo}} <- info(daemons), + {server, Pid} <- DeamonInfo]; +info(ToPid) when is_pid(ToPid) -> + call(info, ToPid, timer:seconds(10)). + +change_config(daemons, Options) -> + Daemons = supervisor:which_children(tftp_sup), + [{Pid, change_config(Pid, Options)} || {_, Pid, _, _} <- Daemons]; +change_config(servers, Options) -> + [{Pid, change_config(Pid, Options)} || {_, {ok, DeamonInfo}} <- info(daemons), + {server, Pid} <- DeamonInfo]; +change_config(ToPid, Options) when is_pid(ToPid) -> + BadKeys = [host, port, udp], + BadOptions = [{Key, Val} || {Key, Val} <- Options, + BadKey <- BadKeys, + Key =:= BadKey], + case BadOptions of + [] -> + call({change_config, Options}, ToPid, timer:seconds(10)); + [{Key, Val} | _] -> + {error, {badarg, {Key, Val}}} + end. + +call(Req, ToPid, Timeout) when is_pid(ToPid) -> + Type = process, + Ref = erlang:monitor(Type, ToPid), + ToPid ! {Req, Ref, self()}, + receive + {Reply, Ref, FromPid} when FromPid =:= ToPid -> + erlang:demonitor(Ref, [flush]), + Reply; + {'DOWN', Ref, Type, FromPid, _Reason} when FromPid =:= ToPid -> + {error, timeout} + after Timeout -> + {error, timeout} + end. + +reply(Reply, Ref, ToPid) -> + ToPid ! {Reply, Ref, self()}. + +%%%------------------------------------------------------------------- +%%% Daemon +%%%------------------------------------------------------------------- + +%% Returns {ok, Port} +daemon_start(Options) when is_list(Options) -> + Config = tftp_lib:parse_config(Options), + proc_lib:start_link(?MODULE, daemon_init, [Config], infinity). + +daemon_init(Config) when is_record(Config, config), + is_pid(Config#config.parent_pid) -> + process_flag(trap_exit, true), + UdpOptions = prepare_daemon_udp(Config), + case catch gen_udp:open(Config#config.udp_port, UdpOptions) of + {ok, Socket} -> + {ok, ActualPort} = inet:port(Socket), + proc_lib:init_ack({ok, self()}), + Config2 = Config#config{udp_socket = Socket, + udp_port = ActualPort}, + print_debug_info(Config2, daemon, open, #tftp_msg_req{filename = ""}), + ServerTab = ets:new(tftp_daemon_servers, [{keypos, 2}]), + FileTab = ets:new(tftp_daemon_files, [{keypos, 2}]), + State = #daemon_state{config = Config2, + n_servers = 0, + server_tab = ServerTab, + file_tab = FileTab}, + daemon_loop(State); + {error, Reason} -> + Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])), + print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")), + exit({gen_udp_open, UdpOptions, Reason}); + Reason -> + Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])), + print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")), + exit({gen_udp_open, UdpOptions, Reason}) + end. + +prepare_daemon_udp(#config{udp_port = Port, udp_options = UdpOptions} = Config) -> + case lists:keymember(fd, 1, UdpOptions) of + true -> + %% Use explicit fd + UdpOptions; + false -> + %% Use fd from setuid_socket_wrap, such as -tftpd_69 + InitArg = list_to_atom("tftpd_" ++ integer_to_list(Port)), + case init:get_argument(InitArg) of + {ok, [[FdStr]] = Badarg} when is_list(FdStr) -> + case catch list_to_integer(FdStr) of + Fd when is_integer(Fd) -> + [{fd, Fd} | UdpOptions]; + {'EXIT', _} -> + Text = lists:flatten(io_lib:format("Illegal prebound fd ~p: ~p", [InitArg, Badarg])), + print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")), + exit({badarg, {prebound_fd, InitArg, Badarg}}) + end; + {ok, Badarg} -> + Text = lists:flatten(io_lib:format("Illegal prebound fd ~p: ~p", [InitArg, Badarg])), + print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")), + exit({badarg, {prebound_fd, InitArg, Badarg}}); + error -> + UdpOptions + end + end. + +daemon_loop(DaemonConfig, N, Servers) when is_list(Servers) -> + %% Handle upgrade from old releases. Please, remove this function in next release. + ServerTab = ets:new(tftp_daemon_servers, [{keypos, 2}]), + FileTab = ets:new(tftp_daemon_files, [{keypos, 2}]), + State = #daemon_state{config = DaemonConfig, + n_servers = N, + server_tab = ServerTab, + file_tab = FileTab}, + Req = #tftp_msg_req{filename = dummy}, + [ets:insert(ServerTab, #server_info{pid = Pid, req = Req, peer = dummy}) || Pid <- Servers], + daemon_loop(State). + +daemon_loop(#daemon_state{config = DaemonConfig, + n_servers = N, + server_tab = ServerTab, + file_tab = FileTab} = State) when is_record(DaemonConfig, config) -> + %% info_msg(DaemonConfig, "=====> TFTP: Daemon #~p\n", [N]), %% XXX + receive + {info, Ref, FromPid} when is_pid(FromPid) -> + Fun = fun(#server_info{pid = Pid}, Acc) -> [{server, Pid} | Acc] end, + ServerInfo = ets:foldl(Fun, [], ServerTab), + Info = internal_info(DaemonConfig, daemon) ++ [{n_conn, N}] ++ ServerInfo, + reply({ok, Info}, Ref, FromPid), + ?MODULE:daemon_loop(State); + {{change_config, Options}, Ref, FromPid} when is_pid(FromPid) -> + case catch tftp_lib:parse_config(Options, DaemonConfig) of + {'EXIT', Reason} -> + reply({error, Reason}, Ref, FromPid), + ?MODULE:daemon_loop(State); + DaemonConfig2 when is_record(DaemonConfig2, config) -> + reply(ok, Ref, FromPid), + ?MODULE:daemon_loop(State#daemon_state{config = DaemonConfig2}) + end; + {udp, Socket, RemoteHost, RemotePort, Bin} when is_binary(Bin) -> + inet:setopts(Socket, [{active, once}]), + ServerConfig = DaemonConfig#config{parent_pid = self(), + udp_host = RemoteHost, + udp_port = RemotePort}, + Msg = (catch tftp_lib:decode_msg(Bin)), + print_debug_info(ServerConfig, daemon, recv, Msg), + case Msg of + Req when is_record(Req, tftp_msg_req), + N =< DaemonConfig#config.max_conn -> + Peer = peer_info(ServerConfig), + PeerReq = {Peer, Req}, + PeerInfo = lists:flatten(io_lib:format("~p", [Peer])), + case ets:lookup(FileTab, PeerReq) of + [] -> + Args = [ServerConfig, Req], + Pid = proc_lib:spawn_link(?MODULE, server_init, Args), + ets:insert(ServerTab, #server_info{pid = Pid, req = Req, peer = Peer}), + ets:insert(FileTab, #file_info{peer_req = PeerReq, pid = Pid}), + ?MODULE:daemon_loop(State#daemon_state{n_servers = N + 1}); + [#file_info{pid = Pid}] -> + %% Yet another request of the file from same peer + warning_msg(DaemonConfig, "~p Reuse connection for ~s\n\t~p\n", + [Pid, PeerInfo, Req#tftp_msg_req.filename]), + ?MODULE:daemon_loop(State) + end; + Req when is_record(Req, tftp_msg_req) -> + Reply = #tftp_msg_error{code = enospc, text = "Too many connections"}, + Peer = peer_info(ServerConfig), + PeerInfo = lists:flatten(io_lib:format("~p", [Peer])), + warning_msg(DaemonConfig, + "Daemon has too many connections (~p)." + "\n\tRejecting request from ~s\n", + [N, PeerInfo]), + send_msg(ServerConfig, daemon, Reply), + ?MODULE:daemon_loop(State); + {'EXIT', Reply} when is_record(Reply, tftp_msg_error) -> + send_msg(ServerConfig, daemon, Reply), + ?MODULE:daemon_loop(State); + Req -> + Reply = #tftp_msg_error{code = badop, + text = "Illegal TFTP operation"}, + warning_msg(DaemonConfig, "Daemon received: ~p.\n\tfrom ~p:~p", + [Req, RemoteHost, RemotePort]), + send_msg(ServerConfig, daemon, Reply), + ?MODULE:daemon_loop(State) + end; + {system, From, Msg} -> + Misc = #sys_misc{module = ?MODULE, function = daemon_loop, arguments = [State]}, + sys:handle_system_msg(Msg, From, DaemonConfig#config.parent_pid, ?MODULE, [], Misc); + {'EXIT', Pid, Reason} when DaemonConfig#config.parent_pid =:= Pid -> + close_port(DaemonConfig, daemon, #tftp_msg_req{filename = ""}), + exit(Reason); + {'EXIT', Pid, _Reason} = Info -> + case ets:lookup(ServerTab, Pid) of + [] -> + warning_msg(DaemonConfig, "Daemon received: ~p", [Info]), + ?MODULE:daemon_loop(State); + [#server_info{req = Req, peer = Peer}] -> + PeerReq = {Peer, Req}, + ets:delete(FileTab, PeerReq), + ets:delete(ServerTab, Pid), + ?MODULE:daemon_loop(State#daemon_state{n_servers = N - 1}) + end; + Info -> + warning_msg(DaemonConfig, "Daemon received: ~p", [Info]), + ?MODULE:daemon_loop(State) + end; +daemon_loop(#daemon_state{config = Config} = State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + Config2 = upgrade_config(Config), + daemon_loop(State#daemon_state{config = Config2}). + +upgrade_config({config, ParentPid, UdpSocket, UdpOptions, UdpHost, UdpPort, PortPolicy, + UseTsize, MaxTsize, MaxConn, Rejected, PoliteAck, DebugLevel, + Timeout, UserOptions, Callbacks}) -> + Callbacks2 = tftp_lib:add_default_callbacks(Callbacks), + Logger = tftp_logger, + MaxRetries = 5, + {config, ParentPid, UdpSocket, UdpOptions, UdpHost, UdpPort, PortPolicy, + UseTsize, MaxTsize, MaxConn, Rejected, PoliteAck, DebugLevel, + Timeout, UserOptions, Callbacks2, Logger, MaxRetries}. + +%%%------------------------------------------------------------------- +%%% Server +%%%------------------------------------------------------------------- + +server_init(Config, Req) when is_record(Config, config), + is_pid(Config#config.parent_pid), + is_record(Req, tftp_msg_req) -> + process_flag(trap_exit, true), + %% Config = + %% case os:getenv("TFTPDEBUG") of + %% false -> + %% Config0; + %% DebugLevel -> + %% Config0#config{debug_level = list_to_atom(DebugLevel)} + %% end, + SuggestedOptions = Req#tftp_msg_req.options, + UdpOptions = Config#config.udp_options, + UdpOptions2 = lists:keydelete(fd, 1, UdpOptions), + Config1 = Config#config{udp_options = UdpOptions2}, + Config2 = tftp_lib:parse_config(SuggestedOptions, Config1), + SuggestedOptions2 = Config2#config.user_options, + Req2 = Req#tftp_msg_req{options = SuggestedOptions2}, + case open_free_port(Config2, server, Req2) of + {ok, Config3} -> + Filename = Req#tftp_msg_req.filename, + case match_callback(Filename, Config3#config.callbacks) of + {ok, Callback} -> + print_debug_info(Config3, server, match, Callback), + case pre_verify_options(Config3, Req2) of + ok -> + case callback({open, server_open}, Config3, Callback, Req2) of + {Callback2, {ok, AcceptedOptions}} -> + {LocalAccess, _} = local_file_access(Req2), + OptText = "Internal error. Not allowed to add new options.", + case post_verify_options(Config3, Req2, AcceptedOptions, OptText) of + {ok, Config4, Req3} when AcceptedOptions =/= [] -> + Reply = #tftp_msg_oack{options = AcceptedOptions}, + BlockNo = + case LocalAccess of + read -> 0; + write -> 1 + end, + {Config5, Callback3, TransferRes} = + transfer(Config4, Callback2, Req3, Reply, LocalAccess, BlockNo, #prepared{}), + common_loop(Config5, Callback3, Req3, TransferRes, LocalAccess, BlockNo); + {ok, Config4, Req3} when LocalAccess =:= write -> + BlockNo = 0, + common_ack(Config4, Callback2, Req3, LocalAccess, BlockNo, #prepared{}); + {ok, Config4, Req3} when LocalAccess =:= read -> + BlockNo = 0, + common_read(Config4, Callback2, Req3, LocalAccess, BlockNo, BlockNo, #prepared{}); + {error, {Code, Text}} -> + {undefined, Error} = + callback({abort, {Code, Text}}, Config3, Callback2, Req2), + send_msg(Config3, Req, Error), + terminate(Config3, Req2, ?ERROR(post_verify_options, Code, Text, Req2#tftp_msg_req.filename)) + end; + {undefined, #tftp_msg_error{code = Code, text = Text} = Error} -> + send_msg(Config3, Req, Error), + terminate(Config3, Req, ?ERROR(server_open, Code, Text, Req2#tftp_msg_req.filename)) + end; + {error, {Code, Text}} -> + {undefined, Error} = + callback({abort, {Code, Text}}, Config2, Callback, Req2), + send_msg(Config2, Req, Error), + terminate(Config2, Req2, ?ERROR(pre_verify_options, Code, Text, Req2#tftp_msg_req.filename)) + end; + {error, #tftp_msg_error{code = Code, text = Text} = Error} -> + send_msg(Config3, Req, Error), + terminate(Config3, Req, ?ERROR(match_callback, Code, Text, Req2#tftp_msg_req.filename)) + end; + #error{} = Error -> + terminate(Config2, Req, Error) + end; +server_init(Config, Req) when is_record(Req, tftp_msg_req) -> + Config2 = upgrade_config(Config), + server_init(Config2, Req). + +%%%------------------------------------------------------------------- +%%% Client +%%%------------------------------------------------------------------- + +%% LocalFilename = filename() | 'binary' | binary() +%% Returns {ok, LastCallbackState} | {error, Reason} +client_start(Access, RemoteFilename, LocalFilename, Options) -> + Config = tftp_lib:parse_config(Options), + Config2 = Config#config{parent_pid = self(), + udp_socket = undefined}, + Req = #tftp_msg_req{access = Access, + filename = RemoteFilename, + mode = lookup_mode(Config2#config.user_options), + options = Config2#config.user_options, + local_filename = LocalFilename}, + Args = [Config2, Req], + case proc_lib:start_link(?MODULE, client_init, Args, infinity) of + {ok, LastCallbackState} -> + {ok, LastCallbackState}; + {error, Error} -> + {error, Error} + end. + +client_init(Config, Req) when is_record(Config, config), + is_pid(Config#config.parent_pid), + is_record(Req, tftp_msg_req) -> + process_flag(trap_exit, true), + %% Config = + %% case os:getenv("TFTPDEBUG") of + %% false -> + %% Config0; + %% "none" -> + %% Config0; + %% DebugLevel -> + %% info_msg(Config, "TFTPDEBUG: ~s\n", [DebugLevel]), + %% Config0#config{debug_level = list_to_atom(DebugLevel)} + %% end, + case open_free_port(Config, client, Req) of + {ok, Config2} -> + Req2 = + case Config2#config.use_tsize of + true -> + SuggestedOptions = Req#tftp_msg_req.options, + SuggestedOptions2 = tftp_lib:replace_val("tsize", "0", SuggestedOptions), + Req#tftp_msg_req{options = SuggestedOptions2}; + false -> + Req + end, + LocalFilename = Req2#tftp_msg_req.local_filename, + case match_callback(LocalFilename, Config2#config.callbacks) of + {ok, Callback} -> + print_debug_info(Config2, client, match, Callback), + client_prepare(Config2, Callback, Req2); + {error, #tftp_msg_error{code = Code, text = Text}} -> + terminate(Config, Req, ?ERROR(match, Code, Text, Req#tftp_msg_req.filename)) + end; + #error{} = Error -> + terminate(Config, Req, Error) + end. + +client_prepare(Config, Callback, Req) when is_record(Req, tftp_msg_req) -> + case pre_verify_options(Config, Req) of + ok -> + case callback({open, client_prepare}, Config, Callback, Req) of + {Callback2, {ok, AcceptedOptions}} -> + OptText = "Internal error. Not allowed to add new options.", + case post_verify_options(Config, Req, AcceptedOptions, OptText) of + {ok, Config2, Req2} -> + {LocalAccess, _} = local_file_access(Req2), + BlockNo = 0, + {Config3, Callback3, TransferRes} = + transfer(Config2, Callback2, Req2, Req2, LocalAccess, BlockNo, #prepared{}), + client_open(Config3, Callback3, Req2, BlockNo, TransferRes); + {error, {Code, Text}} -> + callback({abort, {Code, Text}}, Config, Callback2, Req), + terminate(Config, Req, ?ERROR(post_verify_options, Code, Text, Req#tftp_msg_req.filename)) + end; + {undefined, #tftp_msg_error{code = Code, text = Text}} -> + terminate(Config, Req, ?ERROR(client_prepare, Code, Text, Req#tftp_msg_req.filename)) + end; + {error, {Code, Text}} -> + callback({abort, {Code, Text}}, Config, Callback, Req), + terminate(Config, Req, ?ERROR(pre_verify_options, Code, Text, Req#tftp_msg_req.filename)) + end. + +client_open(Config, Callback, Req, BlockNo, #transfer_res{status = Status, decoded_msg = DecodedMsg, prepared = Prepared}) -> + {LocalAccess, _} = local_file_access(Req), + case Status of + ok when is_record(Prepared, prepared) -> + case DecodedMsg of + Msg when is_record(Msg, tftp_msg_oack) -> + ServerOptions = Msg#tftp_msg_oack.options, + OptText = "Protocol violation. Server is not allowed new options", + case post_verify_options(Config, Req, ServerOptions, OptText) of + {ok, Config2, Req2} -> + {Config3, Callback2, Req3} = + do_client_open(Config2, Callback, Req2), + case LocalAccess of + read -> + common_read(Config3, Callback2, Req3, LocalAccess, BlockNo, BlockNo, Prepared); + write -> + common_ack(Config3, Callback2, Req3, LocalAccess, BlockNo, Prepared) + end; + {error, {Code, Text}} -> + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback, Req), + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(verify_server_options, Code, Text, Req#tftp_msg_req.filename)) + end; + #tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read -> + Req2 = Req#tftp_msg_req{options = []}, + {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2), + ExpectedBlockNo = 0, + common_read(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared); + #tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write -> + Req2 = Req#tftp_msg_req{options = []}, + {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2), + ExpectedBlockNo = 1, + common_write(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared); + %% #tftp_msg_error{code = Code, text = Text} when Req#tftp_msg_req.options =/= [] -> + %% %% Retry without options + %% callback({abort, {Code, Text}}, Config, Callback, Req), + %% Req2 = Req#tftp_msg_req{options = []}, + %% client_prepare(Config, Callback, Req2); + #tftp_msg_error{code = Code, text = Text} -> + callback({abort, {Code, Text}}, Config, Callback, Req), + terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename)); + {'EXIT', #tftp_msg_error{code = Code, text = Text}} -> + callback({abort, {Code, Text}}, Config, Callback, Req), + terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename)); + Msg when is_tuple(Msg) -> + Code = badop, + Text = "Illegal TFTP operation", + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback, Req), + send_msg(Config, Req, Error), + Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]), + terminate(Config, Req, ?ERROR(client_open, Code, Text2, Req#tftp_msg_req.filename)) + end; + error when is_record(Prepared, tftp_msg_error) -> + #tftp_msg_error{code = Code, text = Text} = Prepared, + callback({abort, {Code, Text}}, Config, Callback, Req), + terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename)) + end. + +do_client_open(Config, Callback, Req) -> + case callback({open, client_open}, Config, Callback, Req) of + {Callback2, {ok, FinalOptions}} -> + OptText = "Internal error. Not allowed to change options.", + case post_verify_options(Config, Req, FinalOptions, OptText) of + {ok, Config2, Req2} -> + {Config2, Callback2, Req2}; + {error, {Code, Text}} -> + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback2, Req), + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(post_verify_options, Code, Text, Req#tftp_msg_req.filename)) + end; + {undefined, #tftp_msg_error{code = Code, text = Text} = Error} -> + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename)) + end. + +%%%------------------------------------------------------------------- +%%% Common loop for both client and server +%%%------------------------------------------------------------------- + +common_loop(Config, Callback, Req, #transfer_res{status = Status, decoded_msg = DecodedMsg, prepared = Prepared}, LocalAccess, ExpectedBlockNo) + when is_record(Config, config)-> + %% Config = + %% case os:getenv("TFTPMAX") of + %% false -> + %% Config0; + %% MaxBlockNoStr when Config0#config.debug_level =/= none -> + %% case list_to_integer(MaxBlockNoStr) of + %% MaxBlockNo when ExpectedBlockNo > MaxBlockNo -> + %% info_msg(Config, "TFTPMAX: ~p\n", [MaxBlockNo]), + %% info_msg(Config, "TFTPDEBUG: none\n", []), + %% Config0#config{debug_level = none}; + %% _ -> + %% Config0 + %% end; + %% _MaxBlockNoStr -> + %% Config0 + %% end, + case Status of + ok when is_record(Prepared, prepared) -> + case DecodedMsg of + #tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read -> + common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared); + #tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write -> + common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared); + #tftp_msg_error{code = Code, text = Text} -> + callback({abort, {Code, Text}}, Config, Callback, Req), + terminate(Config, Req, ?ERROR(common_loop, Code, Text, Req#tftp_msg_req.filename)); + {'EXIT', #tftp_msg_error{code = Code, text = Text} = Error} -> + callback({abort, {Code, Text}}, Config, Callback, Req), + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(common_loop, Code, Text, Req#tftp_msg_req.filename)); + Msg when is_tuple(Msg) -> + Code = badop, + Text = "Illegal TFTP operation", + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback, Req), + send_msg(Config, Req, Error), + Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]), + terminate(Config, Req, ?ERROR(common_loop, Code, Text2, Req#tftp_msg_req.filename)) + end; + error when is_record(Prepared, tftp_msg_error) -> + #tftp_msg_error{code = Code, text = Text} = Prepared, + send_msg(Config, Req, Prepared), + terminate(Config, Req, ?ERROR(transfer, Code, Text, Req#tftp_msg_req.filename)) + end; +common_loop(Config, Callback, Req, TransferRes, LocalAccess, ExpectedBlockNo) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + Config2 = upgrade_config(Config), + common_loop(Config2, Callback, Req, TransferRes, LocalAccess, ExpectedBlockNo). + +-spec common_read(#config{}, #callback{}, _, 'read', _, _, #prepared{}) -> no_return(). + +common_read(Config, _, Req, _, _, _, #prepared{status = terminate, result = Result}) -> + terminate(Config, Req, {ok, Result}); +common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared) + when ActualBlockNo =:= ExpectedBlockNo, is_record(Prepared, prepared) -> + case early_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Prepared) of + {Callback2, #prepared{status = more, next_data = Data} = Prepared2} when is_binary(Data) -> + Prepared3 = Prepared2#prepared{prev_data = Data, next_data = undefined}, + do_common_read(Config, Callback2, Req, LocalAccess, ActualBlockNo, Data, Prepared3); + {undefined, #prepared{status = last, next_data = Data} = Prepared2} when is_binary(Data) -> + Prepared3 = Prepared2#prepared{status = terminate}, + do_common_read(Config, undefined, Req, LocalAccess, ActualBlockNo, Data, Prepared3); + {undefined, #prepared{status = error, result = Error}} -> + #tftp_msg_error{code = Code, text = Text} = Error, + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)) + end; +common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared) + when ActualBlockNo =:= (ExpectedBlockNo - 1), is_record(Prepared, prepared) -> + case Prepared of + #prepared{status = more, prev_data = Data} when is_binary(Data) -> + do_common_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Data, Prepared); + #prepared{status = last, prev_data = Data} when is_binary(Data) -> + do_common_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Data, Prepared); + #prepared{status = error, result = Error} -> + #tftp_msg_error{code = Code, text = Text} = Error, + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)) + end; +common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared) + when ActualBlockNo =< ExpectedBlockNo, is_record(Prepared, prepared) -> + %% error_logger:error_msg("TFTP READ ~s: Expected block ~p but got block ~p - IGNORED\n", + %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]), + case Prepared of + #prepared{status = more, prev_data = Data} when is_binary(Data) -> + Reply = #tftp_msg_data{block_no = ExpectedBlockNo, data = Data}, + {Config2, Callback2, TransferRes} = + wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared), + ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo); + #prepared{status = last, prev_data = Data} when is_binary(Data) -> + Reply = #tftp_msg_data{block_no = ExpectedBlockNo, data = Data}, + {Config2, Callback2, TransferRes} = + wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared), + ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo); + #prepared{status = error, result = Error} -> + #tftp_msg_error{code = Code, text = Text} = Error, + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)) + end; +common_read(Config, Callback, Req, _LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared) + when is_record(Prepared, prepared) -> + Code = badblk, + Text = "Unknown transfer ID = " ++ + integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")", + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback, Req), + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)). + +-spec do_common_read(#config{}, #callback{} | undefined, _, 'read', integer(), binary(), #prepared{}) -> no_return(). + +do_common_read(Config, Callback, Req, LocalAccess, BlockNo, Data, Prepared) + when is_binary(Data), is_record(Prepared, prepared) -> + NextBlockNo = BlockNo + 1, + case NextBlockNo =< 65535 of + true -> + Reply = #tftp_msg_data{block_no = NextBlockNo, data = Data}, + {Config2, Callback2, TransferRes} = + transfer(Config, Callback, Req, Reply, LocalAccess, NextBlockNo, Prepared), + ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, NextBlockNo); + false -> + Code = badblk, + Text = "Too big transfer ID = " ++ + integer_to_list(NextBlockNo) ++ " > 65535", + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback, Req), + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)) + end. + +-spec common_write(#config{}, #callback{}, _, 'write', integer(), integer(), _, #prepared{}) -> no_return(). + +common_write(Config, _, Req, _, _, _, _, #prepared{status = terminate, result = Result}) -> + terminate(Config, Req, {ok, Result}); +common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared) + when ActualBlockNo =:= ExpectedBlockNo, is_binary(Data), is_record(Prepared, prepared) -> + case callback({write, Data}, Config, Callback, Req) of + {Callback2, #prepared{status = more} = Prepared2} -> + common_ack(Config, Callback2, Req, LocalAccess, ActualBlockNo, Prepared2); + {undefined, #prepared{status = last, result = Result} = Prepared2} -> + Config2 = pre_terminate(Config, Req, {ok, Result}), + Prepared3 = Prepared2#prepared{status = terminate}, + common_ack(Config2, undefined, Req, LocalAccess, ActualBlockNo, Prepared3); + {undefined, #prepared{status = error, result = Error}} -> + #tftp_msg_error{code = Code, text = Text} = Error, + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(write, Code, Text, Req#tftp_msg_req.filename)) + end; +common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared) + when ActualBlockNo =:= (ExpectedBlockNo - 1), is_binary(Data), is_record(Prepared, prepared) -> + common_ack(Config, Callback, Req, LocalAccess, ExpectedBlockNo - 1, Prepared); +common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared) + when ActualBlockNo =< ExpectedBlockNo, is_binary(Data), is_record(Prepared, prepared) -> + %% error_logger:error_msg("TFTP WRITE ~s: Expected block ~p but got block ~p - IGNORED\n", + %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]), + Reply = #tftp_msg_ack{block_no = ExpectedBlockNo}, + {Config2, Callback2, TransferRes} = + wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared), + ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo); +common_write(Config, Callback, Req, _, ExpectedBlockNo, ActualBlockNo, Data, Prepared) + when is_binary(Data), is_record(Prepared, prepared) -> + Code = badblk, + Text = "Unknown transfer ID = " ++ + integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")", + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback, Req), + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(write, Code, Text, Req#tftp_msg_req.filename)). + +common_ack(Config, Callback, Req, LocalAccess, BlockNo, Prepared) + when is_record(Prepared, prepared) -> + Reply = #tftp_msg_ack{block_no = BlockNo}, + NextBlockNo = BlockNo + 1, + {Config2, Callback2, TransferRes} = + transfer(Config, Callback, Req, Reply, LocalAccess, NextBlockNo, Prepared), + case NextBlockNo =< 65535 of + true -> + ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, NextBlockNo); + false -> + Code = badblk, + Text = "Too big transfer ID = " ++ + integer_to_list(NextBlockNo) ++ " > 65535", + {undefined, Error} = + callback({abort, {Code, Text}}, Config, Callback2, Req), + send_msg(Config, Req, Error), + terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)) + end. + +pre_terminate(Config, Req, Result) -> + if + Req#tftp_msg_req.local_filename =/= undefined, + Config#config.parent_pid =/= undefined -> + proc_lib:init_ack(Result), + unlink(Config#config.parent_pid), + Config#config{parent_pid = undefined, polite_ack = true}; + true -> + Config#config{polite_ack = true} + end. + +-spec terminate(#config{}, #tftp_msg_req{}, {'ok', _} | #error{}) -> no_return(). + +terminate(Config, Req, Result) -> + Result2 = + case Result of + {ok, _} -> + Result; + #error{where = Where, code = Code, text = Text} = Error -> + print_debug_info(Config, Req, Where, Error#error{filename = Req#tftp_msg_req.filename}), + {error, {Where, Code, Text}} + end, + if + Config#config.parent_pid =:= undefined -> + close_port(Config, client, Req), + exit(normal); + Req#tftp_msg_req.local_filename =/= undefined -> + %% Client + close_port(Config, client, Req), + proc_lib:init_ack(Result2), + unlink(Config#config.parent_pid), + exit(normal); + true -> + %% Server + close_port(Config, server, Req), + exit(shutdown) + end. + +close_port(Config, Who, Req) when is_record(Req, tftp_msg_req) -> + case Config#config.udp_socket of + undefined -> + ignore; + Socket -> + print_debug_info(Config, Who, close, Req), + gen_udp:close(Socket) + end. + +open_free_port(Config, Who, Req) when is_record(Config, config), is_record(Req, tftp_msg_req) -> + UdpOptions = Config#config.udp_options, + case Config#config.port_policy of + random -> + %% BUGBUG: Should be a random port + case catch gen_udp:open(0, UdpOptions) of + {ok, Socket} -> + Config2 = Config#config{udp_socket = Socket}, + print_debug_info(Config2, Who, open, Req), + {ok, Config2}; + {error, Reason} -> + Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])), + ?ERROR(open, undef, Text, Req#tftp_msg_req.filename); + {'EXIT', _} = Reason -> + Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])), + ?ERROR(open, undef, Text, Req#tftp_msg_req.filename) + end; + {range, Port, Max} when Port =< Max -> + case catch gen_udp:open(Port, UdpOptions) of + {ok, Socket} -> + Config2 = Config#config{udp_socket = Socket}, + print_debug_info(Config2, Who, open, Req), + {ok, Config2}; + {error, eaddrinuse} -> + PortPolicy = {range, Port + 1, Max}, + Config2 = Config#config{port_policy = PortPolicy}, + open_free_port(Config2, Who, Req); + {error, Reason} -> + Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])), + ?ERROR(open, undef, Text, Req#tftp_msg_req.filename); + {'EXIT', _} = Reason-> + Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])), + ?ERROR(open, undef, Text, Req#tftp_msg_req.filename) + end; + {range, Port, _Max} -> + Reason = "Port range exhausted", + Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])), + ?ERROR(Who, undef, Text, Req#tftp_msg_req.filename) + end. + +%%------------------------------------------------------------------- +%% Transfer +%%------------------------------------------------------------------- + +%% Returns {Config, Callback, #transfer_res{}} +transfer(Config, Callback, Req, Msg, LocalAccess, NextBlockNo, Prepared) + when is_record(Prepared, prepared) -> + IoList = tftp_lib:encode_msg(Msg), + Retries = Config#config.max_retries + 1, + do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries). + +do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries) + when is_record(Prepared, prepared), is_integer(Retries), Retries >= 0 -> + case do_send_msg(Config, Req, Msg, IoList) of + ok -> + {Callback2, Prepared2} = + early_read(Config, Callback, Req, LocalAccess, NextBlockNo, Prepared), + do_wait_for_msg_and_handle_timeout(Config, Callback2, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared2, Retries); + {error, _Reason} when Retries > 0 -> + Retries2 = 0, % Just retry once when send fails + do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries2); + {error, Reason} -> + Code = undef, + Text = lists:flatten(io_lib:format("Transfer failed - giving up -> ~p", [Reason])), + Error = #tftp_msg_error{code = Code, text = Text}, + {Config, Callback, #transfer_res{status = error, prepared = Error}} + end. + +wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, LocalAccess, NextBlockNo, Prepared) -> + IoList = tftp_lib:encode_msg(Msg), + Retries = Config#config.max_retries + 1, + do_wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries). + +do_wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries) -> + Code = undef, + Text = "Transfer timed out.", + case wait_for_msg(Config, Callback, Req) of + timeout when Config#config.polite_ack =:= true -> + do_send_msg(Config, Req, Msg, IoList), + case Prepared of + #prepared{status = terminate, result = Result} -> + terminate(Config, Req, {ok, Result}); + #prepared{} -> + terminate(Config, Req, ?ERROR(transfer, Code, Text, Req#tftp_msg_req.filename)) + end; + timeout when Retries > 0 -> + Retries2 = Retries - 1, + do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries2); + timeout -> + Error = #tftp_msg_error{code = Code, text = Text}, + {Config, Callback, #transfer_res{status = error, prepared = Error}}; + {Config2, DecodedMsg} -> + {Config2, Callback, #transfer_res{status = ok, decoded_msg = DecodedMsg, prepared = Prepared}} + end. + +send_msg(Config, Req, Msg) -> + case catch tftp_lib:encode_msg(Msg) of + {'EXIT', Reason} -> + Code = undef, + Text = "Internal error. Encode failed", + Msg2 = #tftp_msg_error{code = Code, text = Text, details = Reason}, + send_msg(Config, Req, Msg2); + IoList -> + do_send_msg(Config, Req, Msg, IoList) + end. + +do_send_msg(#config{udp_socket = Socket, udp_host = RemoteHost, udp_port = RemotePort} = Config, Req, Msg, IoList) -> + %% {ok, LocalPort} = inet:port(Socket), + %% if + %% LocalPort =/= ?TFTP_DEFAULT_PORT -> + %% ok; + %% true -> + %% print_debug_info(Config#config{debug_level = all}, Req, send, Msg), + %% error(Config, + %% "Daemon replies from the default port (~p)\n\t to ~p:~p\n\t¨~p\n", + %% [LocalPort, RemoteHost, RemotePort, Msg]) + %% end, + + print_debug_info(Config, Req, send, Msg), + + %% case os:getenv("TFTPDUMP") of + %% false -> + %% ignore; + %% DumpPath -> + %% trace_udp_send(Req, Msg, IoList, DumpPath) + %% end, + Res = gen_udp:send(Socket, RemoteHost, RemotePort, IoList), + case Res of + ok -> + ok; + {error, einval = Reason} -> + error_msg(Config, + "Stacktrace; ~p\n gen_udp:send(~p, ~p, ~p, ~p) -> ~p\n", + [erlang:get_stacktrace(), Socket, RemoteHost, RemotePort, IoList, {error, Reason}]); + {error, Reason} -> + {error, Reason} + end. + +%% trace_udp_send(#tftp_msg_req{filename = [$/ | RelFile]} = Req, Msg, IoList, DumpPath) -> +%% trace_udp_send(Req#tftp_msg_req{filename = RelFile}, Msg, IoList, DumpPath); +%% trace_udp_send(#tftp_msg_req{filename = RelFile}, +%% #tftp_msg_data{block_no = BlockNo, data = Data}, +%% _IoList, +%% DumpPath) -> +%% File = filename:join([DumpPath, RelFile, "block" ++ string:right(integer_to_list(BlockNo), 5, $0) ++ ".dump"]), +%% if +%% (BlockNo rem 1000) =:= 1 -> +%% info_msg(Config, "TFTPDUMP: Data ~s\n", [File]); +%% true -> +%% ignore +%% end, +%% ok = filelib:ensure_dir(File), +%% ok = file:write_file(File, Data); +%% trace_udp_send(#tftp_msg_req{filename = RelFile}, Msg, _IoList, _DumpPath) -> +%% info_msg(Config, "TFTPDUMP: No data ~s -> ~p\n", [RelFile, element(1, Msg)]). + +wait_for_msg(Config, Callback, Req) -> + receive + {udp, Socket, RemoteHost, RemotePort, Bin} + when is_binary(Bin), Callback#callback.block_no =:= undefined -> + %% Client prepare + inet:setopts(Socket, [{active, once}]), + Config2 = Config#config{udp_host = RemoteHost, + udp_port = RemotePort}, + DecodedMsg = (catch tftp_lib:decode_msg(Bin)), + print_debug_info(Config2, Req, recv, DecodedMsg), + {Config2, DecodedMsg}; + {udp, Socket, Host, Port, Bin} when is_binary(Bin), + Config#config.udp_host =:= Host, + Config#config.udp_port =:= Port -> + inet:setopts(Socket, [{active, once}]), + DecodedMsg = (catch tftp_lib:decode_msg(Bin)), + print_debug_info(Config, Req, recv, DecodedMsg), + {Config, DecodedMsg}; + {info, Ref, FromPid} when is_pid(FromPid) -> + Type = + case Req#tftp_msg_req.local_filename =/= undefined of + true -> client; + false -> server + end, + Info = internal_info(Config, Type), + reply({ok, Info}, Ref, FromPid), + wait_for_msg(Config, Callback, Req); + {{change_config, Options}, Ref, FromPid} when is_pid(FromPid) -> + case catch tftp_lib:parse_config(Options, Config) of + {'EXIT', Reason} -> + reply({error, Reason}, Ref, FromPid), + wait_for_msg(Config, Callback, Req); + Config2 when is_record(Config2, config) -> + reply(ok, Ref, FromPid), + wait_for_msg(Config2, Callback, Req) + end; + {system, From, Msg} -> + Misc = #sys_misc{module = ?MODULE, function = wait_for_msg, arguments = [Config, Callback, Req]}, + sys:handle_system_msg(Msg, From, Config#config.parent_pid, ?MODULE, [], Misc); + {'EXIT', Pid, _Reason} when Config#config.parent_pid =:= Pid -> + Code = undef, + Text = "Parent exited.", + terminate(Config, Req, ?ERROR(wait_for_msg, Code, Text, Req#tftp_msg_req.filename)); + Msg when Req#tftp_msg_req.local_filename =/= undefined -> + warning_msg(Config, "Client received : ~p", [Msg]), + wait_for_msg(Config, Callback, Req); + Msg when Req#tftp_msg_req.local_filename =:= undefined -> + warning_msg(Config, "Server received : ~p", [Msg]), + wait_for_msg(Config, Callback, Req) + after Config#config.timeout * 1000 -> + print_debug_info(Config, Req, recv, timeout), + timeout + end. + +early_read(Config, Callback, Req, LocalAccess, _NextBlockNo, + #prepared{status = Status, next_data = NextData, prev_data = PrevData} = Prepared) -> + if + Status =/= terminate, + LocalAccess =:= read, + Callback#callback.block_no =/= undefined, + NextData =:= undefined -> + case callback(read, Config, Callback, Req) of + {undefined, Error} when is_record(Error, tftp_msg_error) -> + {undefined, Error}; + {Callback2, Prepared2} when is_record(Prepared2, prepared)-> + {Callback2, Prepared2#prepared{prev_data = PrevData}} + end; + true -> + {Callback, Prepared} + end. + +%%------------------------------------------------------------------- +%% Callback +%%------------------------------------------------------------------- + +callback(Access, Config, Callback, Req) -> + {Callback2, Result} = + do_callback(Access, Config, Callback, Req), + print_debug_info(Config, Req, call, {Callback2, Result}), + {Callback2, Result}. + +do_callback(read = Fun, Config, Callback, Req) + when is_record(Config, config), + is_record(Callback, callback), + is_record(Req, tftp_msg_req) -> + Args = [Callback#callback.state], + NextBlockNo = Callback#callback.block_no + 1, + case catch safe_apply(Callback#callback.module, Fun, Args) of + {more, Bin, NewState} when is_binary(Bin) -> + Count = Callback#callback.count + size(Bin), + Callback2 = Callback#callback{state = NewState, + block_no = NextBlockNo, + count = Count}, + Prepared = #prepared{status = more, + result = undefined, + block_no = NextBlockNo, + next_data = Bin}, + verify_count(Config, Callback2, Req, Prepared); + {last, Bin, Result} when is_binary(Bin) -> + Prepared = #prepared{status = last, + result = Result, + block_no = NextBlockNo, + next_data = Bin}, + {undefined, Prepared}; + {error, {Code, Text}} -> + Error = #tftp_msg_error{code = Code, text = Text}, + Prepared = #prepared{status = error, + result = Error}, + {undefined, Prepared}; + Illegal -> + Code = undef, + Text = "Internal error. File handler error.", + callback({abort, {Code, Text, Illegal}}, Config, Callback, Req) + end; +do_callback({write = Fun, Bin}, Config, Callback, Req) + when is_record(Config, config), + is_record(Callback, callback), + is_record(Req, tftp_msg_req), + is_binary(Bin) -> + Args = [Bin, Callback#callback.state], + NextBlockNo = Callback#callback.block_no + 1, + case catch safe_apply(Callback#callback.module, Fun, Args) of + {more, NewState} -> + Count = Callback#callback.count + size(Bin), + Callback2 = Callback#callback{state = NewState, + block_no = NextBlockNo, + count = Count}, + Prepared = #prepared{status = more, + block_no = NextBlockNo}, + verify_count(Config, Callback2, Req, Prepared); + {last, Result} -> + Prepared = #prepared{status = last, + result = Result, + block_no = NextBlockNo}, + {undefined, Prepared}; + {error, {Code, Text}} -> + Error = #tftp_msg_error{code = Code, text = Text}, + Prepared = #prepared{status = error, + result = Error}, + {undefined, Prepared}; + Illegal -> + Code = undef, + Text = "Internal error. File handler error.", + callback({abort, {Code, Text, Illegal}}, Config, Callback, Req) + end; +do_callback({open, Type}, Config, Callback, Req) + when is_record(Config, config), + is_record(Callback, callback), + is_record(Req, tftp_msg_req) -> + {Access, Filename} = local_file_access(Req), + {Fun, BlockNo} = + case Type of + client_prepare -> {prepare, undefined}; + client_open -> {open, 0}; + server_open -> {open, 0} + end, + Mod = Callback#callback.module, + Args = [Access, + Filename, + Req#tftp_msg_req.mode, + Req#tftp_msg_req.options, + Callback#callback.state], + PeerInfo = peer_info(Config), + fast_ensure_loaded(Mod), + Args2 = + case erlang:function_exported(Mod, Fun, length(Args)) of + true -> Args; + false -> [PeerInfo | Args] + end, + case catch safe_apply(Mod, Fun, Args2) of + {ok, AcceptedOptions, NewState} -> + Callback2 = Callback#callback{state = NewState, + block_no = BlockNo, + count = 0}, + {Callback2, {ok, AcceptedOptions}}; + {error, {Code, Text}} -> + {undefined, #tftp_msg_error{code = Code, text = Text}}; + Illegal -> + Code = undef, + Text = "Internal error. File handler error.", + callback({abort, {Code, Text, Illegal}}, Config, Callback, Req) + end; +do_callback({abort, {Code, Text}}, Config, Callback, Req) -> + Error = #tftp_msg_error{code = Code, text = Text}, + do_callback({abort, Error}, Config, Callback, Req); +do_callback({abort, {Code, Text, Details}}, Config, Callback, Req) -> + Error = #tftp_msg_error{code = Code, text = Text, details = Details}, + do_callback({abort, Error}, Config, Callback, Req); +do_callback({abort = Fun, #tftp_msg_error{code = Code, text = Text} = Error}, Config, Callback, Req) + when is_record(Config, config), + is_record(Callback, callback), + is_record(Req, tftp_msg_req) -> + Args = [Code, Text, Callback#callback.state], + catch safe_apply(Callback#callback.module, Fun, Args), + {undefined, Error}; +do_callback({abort, Error}, _Config, undefined, _Req) when is_record(Error, tftp_msg_error) -> + {undefined, Error}. + +peer_info(#config{udp_host = Host, udp_port = Port}) -> + if + is_tuple(Host), size(Host) =:= 4 -> + {inet, tftp_lib:host_to_string(Host), Port}; + is_tuple(Host), size(Host) =:= 8 -> + {inet6, tftp_lib:host_to_string(Host), Port}; + true -> + {undefined, Host, Port} + end. + +match_callback(Filename, Callbacks) -> + if + Filename =:= binary -> + lookup_callback_mod(tftp_binary, Callbacks); + is_binary(Filename) -> + lookup_callback_mod(tftp_binary, Callbacks); + true -> + do_match_callback(Filename, Callbacks) + end. + +do_match_callback(Filename, [C | Tail]) when is_record(C, callback) -> + case catch inets_regexp:match(Filename, C#callback.internal) of + {match, _, _} -> + {ok, C}; + nomatch -> + do_match_callback(Filename, Tail); + Details -> + Code = baduser, + Text = "Internal error. File handler not found", + {error, #tftp_msg_error{code = Code, text = Text, details = Details}} + end; +do_match_callback(Filename, []) -> + Code = baduser, + Text = "Internal error. File handler not found", + {error, #tftp_msg_error{code = Code, text = Text, details = Filename}}. + +lookup_callback_mod(Mod, Callbacks) -> + {value, C} = lists:keysearch(Mod, #callback.module, Callbacks), + {ok, C}. + +verify_count(Config, Callback, Req, Result) -> + case Config#config.max_tsize of + infinity -> + {Callback, Result}; + Max when Callback#callback.count =< Max -> + {Callback, Result}; + _Max -> + Code = enospc, + Text = "Too large file.", + callback({abort, {Code, Text}}, Config, Callback, Req) + end. + +%%------------------------------------------------------------------- +%% Miscellaneous +%%------------------------------------------------------------------- + +internal_info(Config, Type) when is_record(Config, config) -> + {ok, ActualPort} = inet:port(Config#config.udp_socket), + [ + {type, Type}, + {host, tftp_lib:host_to_string(Config#config.udp_host)}, + {port, Config#config.udp_port}, + {local_port, ActualPort}, + {port_policy, Config#config.port_policy}, + {udp, Config#config.udp_options}, + {use_tsize, Config#config.use_tsize}, + {max_tsize, Config#config.max_tsize}, + {max_conn, Config#config.max_conn}, + {rejected, Config#config.rejected}, + {timeout, Config#config.timeout}, + {polite_ack, Config#config.polite_ack}, + {debug, Config#config.debug_level}, + {parent_pid, Config#config.parent_pid} + ] ++ Config#config.user_options ++ Config#config.callbacks. + +local_file_access(#tftp_msg_req{access = Access, + local_filename = Local, + filename = Filename}) -> + case Local =:= undefined of + true -> + %% Server side + {Access, Filename}; + false -> + %% Client side + case Access of + read -> {write, Local}; + write -> {read, Local} + end + end. + +pre_verify_options(Config, Req) -> + Options = Req#tftp_msg_req.options, + case catch verify_reject(Config, Req, Options) of + ok -> + case verify_integer("tsize", 0, Config#config.max_tsize, Options) of + true -> + case verify_integer("blksize", 0, 65464, Options) of + true -> + ok; + false -> + {error, {badopt, "Too large blksize"}} + end; + false -> + {error, {badopt, "Too large tsize"}} + end; + {error, Reason} -> + {error, Reason} + end. + +post_verify_options(Config, Req, NewOptions, Text) -> + OldOptions = Req#tftp_msg_req.options, + BadOptions = + [Key || {Key, _Val} <- NewOptions, + not lists:keymember(Key, 1, OldOptions)], + case BadOptions =:= [] of + true -> + Config2 = Config#config{timeout = lookup_timeout(NewOptions)}, + Req2 = Req#tftp_msg_req{options = NewOptions}, + {ok, Config2, Req2}; + false -> + {error, {badopt, Text}} + end. + +verify_reject(Config, Req, Options) -> + Access = Req#tftp_msg_req.access, + Rejected = Config#config.rejected, + case lists:member(Access, Rejected) of + true -> + {error, {eacces, atom_to_list(Access) ++ " mode not allowed"}}; + false -> + [throw({error, {badopt, Key ++ " not allowed"}}) || + {Key, _} <- Options, lists:member(Key, Rejected)], + ok + end. + +lookup_timeout(Options) -> + case lists:keysearch("timeout", 1, Options) of + {value, {_, Val}} -> + list_to_integer(Val); + false -> + 3 + end. + +lookup_mode(Options) -> + case lists:keysearch("mode", 1, Options) of + {value, {_, Val}} -> + Val; + false -> + "octet" + end. + +verify_integer(Key, Min, Max, Options) -> + case lists:keysearch(Key, 1, Options) of + {value, {_, Val}} when is_list(Val) -> + case catch list_to_integer(Val) of + {'EXIT', _} -> + false; + Int when Int >= Min, is_integer(Min), + Max =:= infinity -> + true; + Int when Int >= Min, is_integer(Min), + Int =< Max, is_integer(Max) -> + true; + _ -> + false + end; + false -> + true + end. + +error_msg(#config{logger = Logger, debug_level = _Level}, F, A) -> + safe_apply(Logger, error_msg, [F, A]). + +warning_msg(#config{logger = Logger, debug_level = Level}, F, A) -> + case Level of + none -> ok; + error -> ok; + _ -> safe_apply(Logger, warning_msg, [F, A]) + end. + +info_msg(#config{logger = Logger}, F, A) -> + safe_apply(Logger, info_msg, [F, A]). + +safe_apply(Mod, Fun, Args) -> + fast_ensure_loaded(Mod), + apply(Mod, Fun, Args). + +fast_ensure_loaded(Mod) -> + case erlang:function_exported(Mod, module_info, 0) of + true -> + ok; + false -> + Res = code:load_file(Mod), + %% io:format("tftp: code:load_file(~p) -> ~p\n", [Mod, Res]), %% XXX + Res + end. + +print_debug_info(#config{debug_level = Level} = Config, Who, Where, Data) -> + if + Level =:= none -> + ok; + is_record(Data, error) -> + do_print_debug_info(Config, Who, Where, Data); + Level =:= warning -> + ok; + Level =:= error -> + ok; + Level =:= all -> + do_print_debug_info(Config, Who, Where, Data); + Where =:= open -> + do_print_debug_info(Config, Who, Where, Data); + Where =:= close -> + do_print_debug_info(Config, Who, Where, Data); + Level =:= brief -> + ok; + Where =/= recv, Where =/= send -> + ok; + is_record(Data, tftp_msg_data), Level =:= normal -> + ok; + is_record(Data, tftp_msg_ack), Level =:= normal -> + ok; + true -> + do_print_debug_info(Config, Who, Where, Data) + end. + +do_print_debug_info(Config, Who, Where, #tftp_msg_data{data = Bin} = Msg) when is_binary(Bin) -> + Msg2 = Msg#tftp_msg_data{data = {bytes, size(Bin)}}, + do_print_debug_info(Config, Who, Where, Msg2); +do_print_debug_info(Config, Who, Where, #tftp_msg_req{local_filename = Filename} = Msg) when is_binary(Filename) -> + Msg2 = Msg#tftp_msg_req{local_filename = binary}, + do_print_debug_info(Config, Who, Where, Msg2); +do_print_debug_info(Config, Who, Where, Data) -> + Local = + case catch inet:port(Config#config.udp_socket) of + {'EXIT', _Reason} -> + 0; + {ok, Port} -> + Port + end, + %% Remote = Config#config.udp_port, + PeerInfo = lists:flatten(io_lib:format("~p", [peer_info(Config)])), + Side = + if + is_record(Who, tftp_msg_req), + Who#tftp_msg_req.local_filename =/= undefined -> + client; + is_record(Who, tftp_msg_req), + Who#tftp_msg_req.local_filename =:= undefined -> + server; + is_atom(Who) -> + Who + end, + case {Where, Data} of + {_, #error{where = Where, code = Code, text = Text, filename = Filename}} -> + do_format(Config, Side, Local, "error ~s ->\n\t~p ~p\n\t~p ~p: ~s\n", + [PeerInfo, self(), Filename, Where, Code, Text]); + {open, #tftp_msg_req{filename = Filename}} -> + do_format(Config, Side, Local, "open ~s ->\n\t~p ~p\n", + [PeerInfo, self(), Filename]); + {close, #tftp_msg_req{filename = Filename}} -> + do_format(Config, Side, Local, "close ~s ->\n\t~p ~p\n", + [PeerInfo, self(), Filename]); + {recv, _} -> + do_format(Config, Side, Local, "recv ~s <-\n\t~p\n", + [PeerInfo, Data]); + {send, _} -> + do_format(Config, Side, Local, "send ~s ->\n\t~p\n", + [PeerInfo, Data]); + {match, _} when is_record(Data, callback) -> + Mod = Data#callback.module, + State = Data#callback.state, + do_format(Config, Side, Local, "match ~s ~p =>\n\t~p\n", + [PeerInfo, Mod, State]); + {call, _} -> + case Data of + {Callback, _Result} when is_record(Callback, callback) -> + Mod = Callback#callback.module, + State = Callback#callback.state, + do_format(Config, Side, Local, "call ~s ~p =>\n\t~p\n", + [PeerInfo, Mod, State]); + {undefined, Result} -> + do_format(Config, Side, Local, "call ~s result =>\n\t~p\n", + [PeerInfo, Result]) + end + end. + +do_format(Config, Side, Local, Format, Args) -> + info_msg(Config, "~p(~p): " ++ Format, [Side, Local | Args]). + +%%------------------------------------------------------------------- +%% System upgrade +%%------------------------------------------------------------------- + +system_continue(_Parent, _Debug, #sys_misc{module = Mod, function = Fun, arguments = Args}) -> + apply(Mod, Fun, Args); +system_continue(Parent, Debug, {Fun, Args}) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + system_continue(Parent, Debug, #sys_misc{module = ?MODULE, function = Fun, arguments = Args}). + +-spec system_terminate(_, _, _, #sys_misc{} | {_, _}) -> no_return(). + +system_terminate(Reason, _Parent, _Debug, #sys_misc{}) -> + exit(Reason); +system_terminate(Reason, Parent, Debug, {Fun, Args}) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + system_terminate(Reason, Parent, Debug, #sys_misc{module = ?MODULE, function = Fun, arguments = Args}). + +system_code_change({Fun, Args}, _Module, _OldVsn, _Extra) -> + {ok, {Fun, Args}}. diff --git a/lib/inets/src/tftp/tftp_file.erl b/lib/inets/src/tftp/tftp_file.erl new file mode 100644 index 0000000000..e0cbb49330 --- /dev/null +++ b/lib/inets/src/tftp/tftp_file.erl @@ -0,0 +1,389 @@ +%% +%% %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% +%% +%% + +%%%------------------------------------------------------------------- +%%% File : tft_file.erl +%%% Author : Hakan Mattsson <[email protected]> +%%% Description : +%%% +%%% Created : 24 May 2004 by Hakan Mattsson <[email protected]> +%%%------------------------------------------------------------------- + +-module(tftp_file). + +%%%------------------------------------------------------------------- +%%% Interface +%%%------------------------------------------------------------------- + +-behaviour(tftp). + +-export([prepare/6, open/6, read/1, write/2, abort/3]). + +%%%------------------------------------------------------------------- +%%% Defines +%%%------------------------------------------------------------------- + +-include_lib("kernel/include/file.hrl"). + +-record(initial, + {filename, + is_native_ascii}). + +-record(state, + {access, + filename, + is_native_ascii, + is_network_ascii, + root_dir, + options, + blksize, + fd, + count, + buffer}). + +%%------------------------------------------------------------------- +%% prepare(Peer, Access, Filename, Mode, SuggestedOptions, InitialState) -> +%% {ok, AcceptedOptions, NewState} | {error, Code, Text} +%% +%% Peer = {PeerType, PeerHost, PeerPort} +%% PeerType = inet | inet6 +%% PeerHost = ip_address() +%% PeerPort = integer() +%% Acess = read | write +%% Filename = string() +%% Mode = string() +%% SuggestedOptions = [{Key, Value}] +%% AcceptedOptions = [{Key, Value}] +%% Key = string() +%% Value = string() +%% InitialState = [] | [{root_dir, string()}] +%% NewState = term() +%% Code = undef | enoent | eacces | enospc | +%% badop | eexist | baduser | badopt | +%% integer() +%% Text = string() +%% +%% Prepares open of a file on the client side. +%% +%% Will be followed by a call to open/4 before any read/write access +%% is performed. The AcceptedOptions will be sent to the server which +%% will reply with those options that it accepts. The options that are +%% accepted by the server will be forwarded to open/4 as SuggestedOptions. +%% +%% No new options may be added, but the ones that are present as +%% SuggestedOptions may be omitted or replaced with new values +%% in the AcceptedOptions. +%%------------------------------------------------------------------- + +prepare(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) -> + %% Client side + case catch handle_options(Access, Filename, Mode, SuggestedOptions, Initial) of + {ok, Filename2, IsNativeAscii, IsNetworkAscii, AcceptedOptions} -> + State = #state{access = Access, + filename = Filename2, + is_native_ascii = IsNativeAscii, + is_network_ascii = IsNetworkAscii, + options = AcceptedOptions, + blksize = lookup_blksize(AcceptedOptions), + count = 0, + buffer = []}, + {ok, AcceptedOptions, State}; + {error, {Code, Text}} -> + {error, {Code, Text}} + end. + +%% --------------------------------------------------------- +%% open(Peer, Access, Filename, Mode, SuggestedOptions, State) -> +%% {ok, AcceptedOptions, NewState} | {error, Code, Text} +%% +%% Peer = {PeerType, PeerHost, PeerPort} +%% PeerType = inet | inet6 +%% PeerHost = ip_address() +%% PeerPort = integer() +%% Acess = read | write +%% Filename = string() +%% Mode = string() +%% SuggestedOptions = [{Key, Value}] +%% AcceptedOptions = [{Key, Value}] +%% Key = string() +%% Value = string() +%% State = InitialState | #state{} +%% InitialState = [] | [{root_dir, string()}] +%% NewState = term() +%% Code = undef | enoent | eacces | enospc | +%% badop | eexist | baduser | badopt | +%% integer() +%% Text = string() +%% +%% Opens a file for read or write access. +%% +%% On the client side where the open/4 call has been preceeded by a +%% call to prepare/4, all options must be accepted or rejected. +%% On the server side, where there are no preceeding prepare/4 call, +%% noo new options may be added, but the ones that are present as +%% SuggestedOptions may be omitted or replaced with new values +%% in the AcceptedOptions. +%%------------------------------------------------------------------- + +open(Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) -> + %% Server side + case prepare(Peer, Access, Filename, Mode, SuggestedOptions, Initial) of + {ok, AcceptedOptions, State} -> + open(Peer, Access, Filename, Mode, AcceptedOptions, State); + {error, {Code, Text}} -> + {error, {Code, Text}} + end; +open(_Peer, Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, state) -> + %% Both sides + case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State) of + {ok, _Filename2, _IsNativeAscii, _IsNetworkAscii, Options} + when Options =:= NegotiatedOptions -> + do_open(State); + {error, {Code, Text}} -> + {error, {Code, Text}} + end; +open(Peer, Access, Filename, Mode, NegotiatedOptions, State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + State2 = upgrade_state(State), + open(Peer, Access, Filename, Mode, NegotiatedOptions, State2). + +do_open(State) when is_record(State, state) -> + case file:open(State#state.filename, file_options(State)) of + {ok, Fd} -> + {ok, State#state.options, State#state{fd = Fd}}; + {error, Reason} when is_atom(Reason) -> + {error, file_error(Reason)} + end. + +file_options(State) -> + case State#state.access of + read -> [read, read_ahead, raw, binary]; + write -> [write, delayed_write, raw, binary] + end. + +file_error(Reason) when is_atom(Reason) -> + Details = file:format_error(Reason), + case Reason of + eexist -> {Reason, Details}; + enoent -> {Reason, Details}; + eacces -> {Reason, Details}; + eperm -> {eacces, Details}; + enospc -> {Reason, Details}; + _ -> {undef, Details ++ " (" ++ atom_to_list(Reason) ++ ")"} + end. + +%%------------------------------------------------------------------- +%% read(State) -> +%% {more, Bin, NewState} | {last, Bin, FileSize} | {error, {Code, Text}} +%% +%% State = term() +%% NewState = term() +%% Bin = binary() +%% FileSize = integer() +%% Code = undef | enoent | eacces | enospc | +%% badop | eexist | baduser | badopt | +%% integer() +%% Text = string() +%% +%% Reads a chunk from the file +%% +%% The file is automatically closed when the last chunk is read. +%%------------------------------------------------------------------- + +read(#state{access = read} = State) -> + BlkSize = State#state.blksize, + case file:read(State#state.fd, BlkSize) of + {ok, Bin} when is_binary(Bin), size(Bin) =:= BlkSize -> + Count = State#state.count + size(Bin), + {more, Bin, State#state{count = Count}}; + {ok, Bin} when is_binary(Bin), size(Bin) < BlkSize -> + file:close(State#state.fd), + Count = State#state.count + size(Bin), + {last, Bin, Count}; + eof -> + {last, <<>>, State#state.count}; + {error, Reason} -> + file:close(State#state.fd), + {error, file_error(Reason)} + end; +read(State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + State2 = upgrade_state(State), + read(State2). + +%%------------------------------------------------------------------- +%% write(Bin, State) -> +%% {more, NewState} | {last, FileSize} | {error, {Code, Text}} +%% +%% State = term() +%% NewState = term() +%% Bin = binary() +%% FileSize = integer() +%% Code = undef | enoent | eacces | enospc | +%% badop | eexist | baduser | badopt | +%% integer() +%% Text = string() +%% +%% Writes a chunk to the file +%% +%% The file is automatically closed when the last chunk is written +%%------------------------------------------------------------------- + +write(Bin, #state{access = write} = State) when is_binary(Bin) -> + Size = size(Bin), + BlkSize = State#state.blksize, + case file:write(State#state.fd, Bin) of + ok when Size =:= BlkSize-> + Count = State#state.count + Size, + {more, State#state{count = Count}}; + ok when Size < BlkSize-> + file:close(State#state.fd), + Count = State#state.count + Size, + {last, Count}; + {error, Reason} -> + file:close(State#state.fd), + file:delete(State#state.filename), + {error, file_error(Reason)} + end; +write(Bin, State) -> + %% Handle upgrade from old releases. Please, remove this clause in next release. + State2 = upgrade_state(State), + write(Bin, State2). + +%%------------------------------------------------------------------- +%% abort(Code, Text, State) -> ok +%% +%% State = term() +%% Code = undef | enoent | eacces | enospc | +%% badop | eexist | baduser | badopt | +%% badblk | integer() +%% Text = string() +%% +%% Aborts the file transfer +%%------------------------------------------------------------------- + +abort(_Code, _Text, #state{fd = Fd, access = Access} = State) -> + file:close(Fd), + case Access of + write -> + ok = file:delete(State#state.filename); + read -> + ok + end. + +%%------------------------------------------------------------------- +%% Process options +%%------------------------------------------------------------------- + +handle_options(Access, Filename, Mode, Options, Initial) -> + I = #initial{filename = Filename, is_native_ascii = is_native_ascii()}, + {Filename2, IsNativeAscii} = handle_initial(Initial, I), + IsNetworkAscii = handle_mode(Mode, IsNativeAscii), + Options2 = do_handle_options(Access, Filename2, Options), + {ok, Filename2, IsNativeAscii, IsNetworkAscii, Options2}. + +handle_mode(Mode, IsNativeAscii) -> + case Mode of + "netascii" when IsNativeAscii =:= true -> true; + "octet" -> false; + _ -> throw({error, {badop, "Illegal mode " ++ Mode}}) + end. + +handle_initial([{root_dir, Dir} | Initial], I) -> + case catch filename_join(Dir, I#initial.filename) of + {'EXIT', _} -> + throw({error, {badop, "Internal error. root_dir is not a string"}}); + Filename2 -> + handle_initial(Initial, I#initial{filename = Filename2}) + end; +handle_initial([{native_ascii, Bool} | Initial], I) -> + case Bool of + true -> handle_initial(Initial, I#initial{is_native_ascii = true}); + false -> handle_initial(Initial, I#initial{is_native_ascii = false}) + end; +handle_initial([], I) when is_record(I, initial) -> + {I#initial.filename, I#initial.is_native_ascii}; +handle_initial(State, _) when is_record(State, state) -> + {State#state.filename, State#state.is_native_ascii}. + +filename_join(Dir, Filename) -> + case filename:pathtype(Filename) of + absolute -> + [_ | RelFilename] = filename:split(Filename), + filename:join([Dir, RelFilename]); + _ -> + filename:join([Dir, Filename]) + end. + +do_handle_options(Access, Filename, [{Key, Val} | T]) -> + case Key of + "tsize" -> + case Access of + read when Val =:= "0" -> + case file:read_file_info(Filename) of + {ok, FI} -> + Tsize = integer_to_list(FI#file_info.size), + [{Key, Tsize} | do_handle_options(Access, Filename, T)]; + {error, _} -> + do_handle_options(Access, Filename, T) + end; + _ -> + handle_integer(Access, Filename, Key, Val, T, 0, infinity) + end; + "blksize" -> + handle_integer(Access, Filename, Key, Val, T, 8, 65464); + "timeout" -> + handle_integer(Access, Filename, Key, Val, T, 1, 255); + _ -> + do_handle_options(Access, Filename, T) + end; +do_handle_options(_Access, _Filename, []) -> + []. + + +handle_integer(Access, Filename, Key, Val, Options, Min, Max) -> + case catch list_to_integer(Val) of + {'EXIT', _} -> + do_handle_options(Access, Filename, Options); + Int when Int >= Min, Int =< Max -> + [{Key, Val} | do_handle_options(Access, Filename, Options)]; + Int when Int >= Min, Max =:= infinity -> + [{Key, Val} | do_handle_options(Access, Filename, Options)]; + _Int -> + throw({error, {badopt, "Illegal " ++ Key ++ " value " ++ Val}}) + end. + +lookup_blksize(Options) -> + case lists:keysearch("blksize", 1, Options) of + {value, {_, Val}} -> + list_to_integer(Val); + false -> + 512 + end. + +is_native_ascii() -> + case os:type() of + {win32, _} -> true; + _ -> false + end. + +%% Handle upgrade from old releases. Please, remove this function in next release. +upgrade_state({state, Access, Filename, RootDir, Options, BlkSize, Fd, Count, Buffer}) -> + {state, Access, Filename, false, false, RootDir, Options, BlkSize, Fd, Count, Buffer}. diff --git a/lib/inets/src/tftp/tftp_lib.erl b/lib/inets/src/tftp/tftp_lib.erl new file mode 100644 index 0000000000..ffb7b9a797 --- /dev/null +++ b/lib/inets/src/tftp/tftp_lib.erl @@ -0,0 +1,473 @@ +%% +%% %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% +%% +%% + +%%%------------------------------------------------------------------- +%%% File : tftp_lib.erl +%%% Author : Hakan Mattsson <[email protected]> +%%% Description : Option parsing, decode, encode etc. +%%% +%%% Created : 18 May 2004 by Hakan Mattsson <[email protected]> +%%%------------------------------------------------------------------- + +-module(tftp_lib). + +%%------------------------------------------------------------------- +%% Interface +%%------------------------------------------------------------------- + +%% application internal functions +-export([ + parse_config/1, + parse_config/2, + decode_msg/1, + encode_msg/1, + replace_val/3, + to_lower/1, + host_to_string/1, + add_default_callbacks/1 + ]). + +%%------------------------------------------------------------------- +%% Defines +%%------------------------------------------------------------------- + +-include("tftp.hrl"). + +-define(LOWER(Char), + if + Char >= $A, Char =< $Z -> + Char - ($A - $a); + true -> + Char + end). + +%%------------------------------------------------------------------- +%% Config +%%------------------------------------------------------------------- + +parse_config(Options) -> + parse_config(Options, #config{}). + +parse_config(Options, Config) -> + do_parse_config(Options, Config). + +do_parse_config([{Key, Val} | Tail], Config) when is_record(Config, config) -> + case Key of + debug -> + if + Val =:= 0; Val =:= none -> + do_parse_config(Tail, Config#config{debug_level = none}); + Val =:= 1; Val =:= error -> + do_parse_config(Tail, Config#config{debug_level = error}); + Val =:= 2; Val =:= warning -> + do_parse_config(Tail, Config#config{debug_level = warning}); + Val =:= 3; Val =:= brief -> + do_parse_config(Tail, Config#config{debug_level = brief}); + Val =:= 4; Val =:= normal -> + do_parse_config(Tail, Config#config{debug_level = normal}); + Val =:= 5; Val =:= verbose -> + do_parse_config(Tail, Config#config{debug_level = verbose}); + Val =:= 6; Val =:= all -> + do_parse_config(Tail, Config#config{debug_level = all}); + true -> + exit({badarg, {Key, Val}}) + end; + host -> + if + is_list(Val) -> + do_parse_config(Tail, Config#config{udp_host = Val}); + is_tuple(Val), size(Val) =:= 4 -> + do_parse_config(Tail, Config#config{udp_host = Val}); + is_tuple(Val), size(Val) =:= 8 -> + do_parse_config(Tail, Config#config{udp_host = Val}); + true -> + exit({badarg, {Key, Val}}) + end; + port -> + if + is_integer(Val), Val >= 0 -> + Config2 = Config#config{udp_port = Val, udp_options = Config#config.udp_options}, + do_parse_config(Tail, Config2); + true -> + exit({badarg, {Key, Val}}) + end; + port_policy -> + case Val of + random -> + do_parse_config(Tail, Config#config{port_policy = Val}); + 0 -> + do_parse_config(Tail, Config#config{port_policy = random}); + MinMax when is_integer(MinMax), MinMax > 0 -> + do_parse_config(Tail, Config#config{port_policy = {range, MinMax, MinMax}}); + {range, Min, Max} when Max >= Min, + is_integer(Min), Min > 0, + is_integer(Max), Max > 0 -> + do_parse_config(Tail, Config#config{port_policy = Val}); + true -> + exit({badarg, {Key, Val}}) + end; + udp when is_list(Val) -> + Fun = + fun({K, V}, List) when K /= active -> + replace_val(K, V, List); + (V, List) when V /= list, V /= binary -> + List ++ [V]; + (V, _List) -> + exit({badarg, {udp, [V]}}) + end, + UdpOptions = lists:foldl(Fun, Config#config.udp_options, Val), + do_parse_config(Tail, Config#config{udp_options = UdpOptions}); + use_tsize -> + case Val of + true -> + do_parse_config(Tail, Config#config{use_tsize = Val}); + false -> + do_parse_config(Tail, Config#config{use_tsize = Val}); + _ -> + exit({badarg, {Key, Val}}) + end; + max_tsize -> + if + Val =:= infinity -> + do_parse_config(Tail, Config#config{max_tsize = Val}); + is_integer(Val), Val >= 0 -> + do_parse_config(Tail, Config#config{max_tsize = Val}); + true -> + exit({badarg, {Key, Val}}) + end; + max_conn -> + if + Val =:= infinity -> + do_parse_config(Tail, Config#config{max_conn = Val}); + is_integer(Val), Val > 0 -> + do_parse_config(Tail, Config#config{max_conn = Val}); + true -> + exit({badarg, {Key, Val}}) + end; + _ when is_list(Key), is_list(Val) -> + Key2 = to_lower(Key), + Val2 = to_lower(Val), + TftpOptions = replace_val(Key2, Val2, Config#config.user_options), + do_parse_config(Tail, Config#config{user_options = TftpOptions}); + reject -> + case Val of + read -> + Rejected = [Val | Config#config.rejected], + do_parse_config(Tail, Config#config{rejected = Rejected}); + write -> + Rejected = [Val | Config#config.rejected], + do_parse_config(Tail, Config#config{rejected = Rejected}); + _ when is_list(Val) -> + Rejected = [Val | Config#config.rejected], + do_parse_config(Tail, Config#config{rejected = Rejected}); + _ -> + exit({badarg, {Key, Val}}) + end; + callback -> + case Val of + {RegExp, Mod, State} when is_list(RegExp), is_atom(Mod) -> + case inets_regexp:parse(RegExp) of + {ok, Internal} -> + Callback = #callback{regexp = RegExp, + internal = Internal, + module = Mod, + state = State}, + Callbacks = Config#config.callbacks ++ [Callback], + do_parse_config(Tail, Config#config{callbacks = Callbacks}); + {error, Reason} -> + exit({badarg, {Key, Val}, Reason}) + end; + _ -> + exit({badarg, {Key, Val}}) + end; + logger -> + if + is_atom(Val) -> + do_parse_config(Tail, Config#config{logger = Val}); + true -> + exit({badarg, {Key, Val}}) + end; + max_retries -> + if + is_integer(Val), Val > 0 -> + do_parse_config(Tail, Config#config{max_retries = Val}); + true -> + exit({badarg, {Key, Val}}) + end; + _ -> + exit({badarg, {Key, Val}}) + end; +do_parse_config([], #config{udp_host = Host, + udp_options = UdpOptions, + user_options = UserOptions, + callbacks = Callbacks} = Config) -> + IsInet6 = lists:member(inet6, UdpOptions), + IsInet = lists:member(inet, UdpOptions), + Host2 = + if + (IsInet and not IsInet6); (not IsInet and not IsInet6) -> + case inet:getaddr(Host, inet) of + {ok, Addr} -> + Addr; + {error, Reason} -> + exit({badarg, {host, Reason}}) + end; + (IsInet6 and not IsInet) -> + case inet:getaddr(Host, inet6) of + {ok, Addr} -> + Addr; + {error, Reason} -> + exit({badarg, {host, Reason}}) + end; + true -> + %% Conflicting options + exit({badarg, {udp, [inet]}}) + end, + UdpOptions2 = lists:reverse(UdpOptions), + TftpOptions = lists:reverse(UserOptions), + Callbacks2 = add_default_callbacks(Callbacks), + Config#config{udp_host = Host2, + udp_options = UdpOptions2, + user_options = TftpOptions, + callbacks = Callbacks2}; +do_parse_config(Options, Config) when is_record(Config, config) -> + exit({badarg, Options}). + +add_default_callbacks(Callbacks) -> + RegExp = "", + {ok, Internal} = inets_regexp:parse(RegExp), + File = #callback{regexp = RegExp, + internal = Internal, + module = tftp_file, + state = []}, + Bin = #callback{regexp = RegExp, + internal = Internal, + module = tftp_binary, + state = []}, + Callbacks ++ [File, Bin]. + +host_to_string(Host) -> + case Host of + String when is_list(String) -> + String; + {A1, A2, A3, A4} -> % inet + lists:concat([A1, ".", A2, ".", A3, ".",A4]); + {A1, A2, A3, A4, A5, A6, A7, A8} -> % inet6 + lists:concat([ + int16_to_hex(A1), "::", + int16_to_hex(A2), "::", + int16_to_hex(A3), "::", + int16_to_hex(A4), "::", + int16_to_hex(A5), "::", + int16_to_hex(A6), "::", + int16_to_hex(A7), "::", + int16_to_hex(A8) + ]) + end. + +int16_to_hex(0) -> + [$0]; +int16_to_hex(I) -> + N1 = ((I bsr 8) band 16#ff), + N2 = (I band 16#ff), + [code_character(N1 div 16), code_character(N1 rem 16), + code_character(N2 div 16), code_character(N2 rem 16)]. + +code_character(N) when N < 10 -> + $0 + N; +code_character(N) -> + $A + (N - 10). + +%%------------------------------------------------------------------- +%% Decode +%%------------------------------------------------------------------- + +decode_msg(Bin) when is_binary(Bin) -> + case Bin of + <<?TFTP_OPCODE_RRQ:16/integer, Tail/binary>> -> + case decode_strings(Tail, [keep_case, lower_case]) of + [Filename, Mode | Strings] -> + Options = decode_options(Strings), + #tftp_msg_req{access = read, + filename = Filename, + mode = to_lower(Mode), + options = Options}; + [_Filename | _Strings] -> + exit(#tftp_msg_error{code = undef, + text = "Missing mode"}); + _ -> + exit(#tftp_msg_error{code = undef, + text = "Missing filename"}) + end; + <<?TFTP_OPCODE_WRQ:16/integer, Tail/binary>> -> + case decode_strings(Tail, [keep_case, lower_case]) of + [Filename, Mode | Strings] -> + Options = decode_options(Strings), + #tftp_msg_req{access = write, + filename = Filename, + mode = to_lower(Mode), + options = Options}; + [_Filename | _Strings] -> + exit(#tftp_msg_error{code = undef, + text = "Missing mode"}); + _ -> + exit(#tftp_msg_error{code = undef, + text = "Missing filename"}) + end; + <<?TFTP_OPCODE_DATA:16/integer, SeqNo:16/integer, Data/binary>> -> + #tftp_msg_data{block_no = SeqNo, data = Data}; + <<?TFTP_OPCODE_ACK:16/integer, SeqNo:16/integer>> -> + #tftp_msg_ack{block_no = SeqNo}; + <<?TFTP_OPCODE_ERROR:16/integer, ErrorCode:16/integer, Tail/binary>> -> + case decode_strings(Tail, [keep_case]) of + [ErrorText] -> + ErrorCode2 = decode_error_code(ErrorCode), + #tftp_msg_error{code = ErrorCode2, + text = ErrorText}; + _ -> + exit(#tftp_msg_error{code = undef, + text = "Trailing garbage"}) + end; + <<?TFTP_OPCODE_OACK:16/integer, Tail/binary>> -> + Strings = decode_strings(Tail, [lower_case]), + Options = decode_options(Strings), + #tftp_msg_oack{options = Options}; + _ -> + exit(#tftp_msg_error{code = undef, + text = "Invalid syntax"}) + end. + +decode_strings(Bin, Cases) when is_binary(Bin), is_list(Cases) -> + do_decode_strings(Bin, Cases, []). + +do_decode_strings(<<>>, _Cases, Strings) -> + lists:reverse(Strings); +do_decode_strings(Bin, [Case | Cases], Strings) -> + {String, Tail} = decode_string(Bin, Case, []), + if + Cases =:= [] -> + do_decode_strings(Tail, [Case], [String | Strings]); + true -> + do_decode_strings(Tail, Cases, [String | Strings]) + end. + +decode_string(<<Char:8/integer, Tail/binary>>, Case, String) -> + if + Char =:= 0 -> + {lists:reverse(String), Tail}; + Case =:= keep_case -> + decode_string(Tail, Case, [Char | String]); + Case =:= lower_case -> + Char2 = ?LOWER(Char), + decode_string(Tail, Case, [Char2 | String]) + end; +decode_string(<<>>, _Case, _String) -> + exit(#tftp_msg_error{code = undef, text = "Trailing null missing"}). + +decode_options([Key, Value | Strings]) -> + [{to_lower(Key), Value} | decode_options(Strings)]; +decode_options([]) -> + []. + +decode_error_code(Int) -> + case Int of + ?TFTP_ERROR_UNDEF -> undef; + ?TFTP_ERROR_ENOENT -> enoent; + ?TFTP_ERROR_EACCES -> eacces; + ?TFTP_ERROR_ENOSPC -> enospc; + ?TFTP_ERROR_BADOP -> badop; + ?TFTP_ERROR_BADBLK -> badblk; + ?TFTP_ERROR_EEXIST -> eexist; + ?TFTP_ERROR_BADUSER -> baduser; + ?TFTP_ERROR_BADOPT -> badopt; + Int when is_integer(Int), Int >= 0, Int =< 65535 -> Int; + _ -> exit(#tftp_msg_error{code = undef, text = "Error code outside range."}) + end. + +%%------------------------------------------------------------------- +%% Encode +%%------------------------------------------------------------------- + +encode_msg(#tftp_msg_req{access = Access, + filename = Filename, + mode = Mode, + options = Options}) -> + OpCode = case Access of + read -> ?TFTP_OPCODE_RRQ; + write -> ?TFTP_OPCODE_WRQ + end, + [ + <<OpCode:16/integer>>, + Filename, + 0, + Mode, + 0, + [[Key, 0, Val, 0] || {Key, Val} <- Options] + ]; +encode_msg(#tftp_msg_data{block_no = BlockNo, data = Data}) when BlockNo =< 65535 -> + [ + <<?TFTP_OPCODE_DATA:16/integer, BlockNo:16/integer>>, + Data + ]; +encode_msg(#tftp_msg_ack{block_no = BlockNo}) when BlockNo =< 65535 -> + <<?TFTP_OPCODE_ACK:16/integer, BlockNo:16/integer>>; +encode_msg(#tftp_msg_error{code = Code, text = Text}) -> + IntCode = encode_error_code(Code), + [ + <<?TFTP_OPCODE_ERROR:16/integer, IntCode:16/integer>>, + Text, + 0 + ]; +encode_msg(#tftp_msg_oack{options = Options}) -> + [ + <<?TFTP_OPCODE_OACK:16/integer>>, + [[Key, 0, Val, 0] || {Key, Val} <- Options] + ]. + +encode_error_code(Code) -> + case Code of + undef -> ?TFTP_ERROR_UNDEF; + enoent -> ?TFTP_ERROR_ENOENT; + eacces -> ?TFTP_ERROR_EACCES; + enospc -> ?TFTP_ERROR_ENOSPC; + badop -> ?TFTP_ERROR_BADOP; + badblk -> ?TFTP_ERROR_BADBLK; + eexist -> ?TFTP_ERROR_EEXIST; + baduser -> ?TFTP_ERROR_BADUSER; + badopt -> ?TFTP_ERROR_BADOPT; + Int when is_integer(Int), Int >= 0, Int =< 65535 -> Int + end. + +%%------------------------------------------------------------------- +%% Miscellaneous +%%------------------------------------------------------------------- + +replace_val(Key, Val, List) -> + case lists:keysearch(Key, 1, List) of + false -> + List ++ [{Key, Val}]; + {value, {_, OldVal}} when OldVal =:= Val -> + List; + {value, {_, _}} -> + lists:keyreplace(Key, 1, List, {Key, Val}) + end. + +to_lower(Chars) -> + [?LOWER(Char) || Char <- Chars]. diff --git a/lib/inets/src/tftp/tftp_logger.erl b/lib/inets/src/tftp/tftp_logger.erl new file mode 100644 index 0000000000..0c3620e665 --- /dev/null +++ b/lib/inets/src/tftp/tftp_logger.erl @@ -0,0 +1,98 @@ +%% +%% %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(tftp_logger). + +%%------------------------------------------------------------------- +%% Interface +%%------------------------------------------------------------------- + +%% public functions +-export([ + error_msg/2, + warning_msg/2, + info_msg/2 + ]). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{error_msg, 2}, {warning_msg, 2}, {info_msg, 2}]; +behaviour_info(_) -> + undefined. + +%%------------------------------------------------------------------- +%% error_msg(Format, Data) -> ok | exit(Reason) +%% +%% Format = string() +%% Data = [term()] +%% Reason = term() +%% +%% Log an error message +%%------------------------------------------------------------------- + +error_msg(Format, Data) -> + {Format2, Data2} = add_timestamp(Format, Data), + error_logger:error_msg(Format2, Data2). + +%%------------------------------------------------------------------- +%% warning_msg(Format, Data) -> ok | exit(Reason) +%% +%% Format = string() +%% Data = [term()] +%% Reason = term() +%% +%% Log a warning message +%%------------------------------------------------------------------- + +warning_msg(Format, Data) -> + {Format2, Data2} = add_timestamp(Format, Data), + error_logger:warning_msg(Format2, Data2). + +%%------------------------------------------------------------------- +%% info_msg(Format, Data) -> ok | exit(Reason) +%% +%% Format = string() +%% Data = [term()] +%% Reason = term() +%% +%% Log an info message +%%------------------------------------------------------------------- + +info_msg(Format, Data) -> + {Format2, Data2} = add_timestamp(Format, Data), + io:format(Format2, Data2). + +%%------------------------------------------------------------------- +%% Add timestamp to log message +%%------------------------------------------------------------------- + +add_timestamp(Format, Data) -> + Now = {_MegaSecs, _Secs, _MicroSecs} = erlang:now(), + {{_Y, _Mo, _D}, {H, Mi, S}} = calendar:now_to_universal_time(Now), + %% {"~p-~s-~sT~s:~s:~sZ,~6.6.0w tftp: " ++ Format ++ "\n", + %% [Y, t(Mo), t(D), t(H), t(Mi), t(S), MicroSecs | Data]}. + {"~s:~s:~s tftp: " ++ Format, [t(H), t(Mi), t(S) | Data]}. + +%% Convert 9 to "09". +t(Int) -> + case integer_to_list(Int) of + [Single] -> [$0, Single]; + Multi -> Multi + end. diff --git a/lib/inets/src/tftp/tftp_sup.erl b/lib/inets/src/tftp/tftp_sup.erl new file mode 100644 index 0000000000..1cafcc1069 --- /dev/null +++ b/lib/inets/src/tftp/tftp_sup.erl @@ -0,0 +1,110 @@ +%% +%% %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% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: The top supervisor for tftp hangs under inets_sup. +%%---------------------------------------------------------------------- + +-module(tftp_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/1, + start_child/1, + stop_child/1, + which_children/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +start_link(TftpServices) -> + supervisor:start_link({local, ?MODULE}, ?MODULE, [TftpServices]). + +start_child(Options) -> + KillAfter = default_kill_after(), + ChildSpec = worker_spec(KillAfter, Options), + supervisor:start_child(?MODULE, ChildSpec). + +stop_child(Pid) when is_pid(Pid) -> + Children = supervisor:which_children(?MODULE), + case [Id || {Id, P, _Type, _Modules} <- Children, P =:= Pid] of + [] -> + {error, not_found}; + [Id] -> + case supervisor:terminate_child(?MODULE, Id) of + ok -> + supervisor:delete_child(?MODULE, Id); + {error, not_found} -> + supervisor:delete_child(?MODULE, Id); + {error, Reason} -> + {error, Reason} + end + end. + +which_children() -> + Children = supervisor:which_children(?MODULE), + [{tftpd, Pid} || {_Id, Pid, _Type, _Modules} <- Children, Pid =/= undefined]. + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([Services]) when is_list(Services) -> + RestartStrategy = one_for_one, + MaxR = 10, + MaxT = 3600, + KillAfter = default_kill_after(), + Children = [worker_spec(KillAfter, Options) || {tftpd, Options} <- Services], + {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. + +%%%========================================================================= +%%% Internal functions +%%%========================================================================= + +worker_spec(KillAfter, Options) -> + Modules = [proc_lib, tftp, tftp_engine], + KA = supervisor_timeout(KillAfter), + Name = unique_name(Options), + {Name, {tftp, start, [Options]}, permanent, KA, worker, Modules}. + +unique_name(Options) -> + case lists:keysearch(port, 1, Options) of + {value, {_, Port}} when is_integer(Port), Port > 0 -> + {tftpd, Port}; + _ -> + {tftpd, erlang:now()} + end. + +default_kill_after() -> + timer:seconds(3). + +%% supervisor_spec(Name) -> +%% {Name, {Name, start, []}, permanent, infinity, supervisor, +%% [Name, supervisor]}. + +-ifdef(debug_shutdown). +supervisor_timeout(_KillAfter) -> timer:hours(24). +-else. +supervisor_timeout(KillAfter) -> KillAfter. +-endif. |