%% ``Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%%
%% $Id: httpd_parse.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
%%
-module(httpd_parse).
-export([
request_header/1,
hsplit/2,
get_request_record/10,
split_lines/1,
tagup_header/1]).
-include("httpd.hrl").
%%----------------------------------------------------------------------
%% request_header
%%
%% Input: The request as sent from the client (list of characters)
%% (may include part of the entity body)
%%
%% Returns:
%% {ok, Info#mod}
%% {not_implemented,Info#mod}
%% {bad_request, Reason}
%%----------------------------------------------------------------------
request_header(Header)->
[RequestLine|HeaderFields] = split_lines(Header),
?DEBUG("request ->"
"~n RequestLine: ~p"
"~n Header: ~p",[RequestLine,Header]),
ParsedHeader = tagup_header(HeaderFields),
?DEBUG("request ->"
"~n ParseHeader: ~p",[ParsedHeader]),
case verify_request(string:tokens(RequestLine," ")) of
["HEAD", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
{ok, ["HEAD", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
ParsedHeader]};
["GET", RequestURI, "HTTP/0.9"] ->
{ok, ["GET", RequestURI, "HTTP/0.9", RequestLine, ParsedHeader]};
["GET", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
{ok, ["GET", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
ParsedHeader]};
["POST", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
{ok, ["POST", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
ParsedHeader]};
%%HTTP must be 1.1 or higher
["TRACE", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] when N>48->
{ok, ["TRACE", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
ParsedHeader]};
[Method, RequestURI] ->
{not_implemented, RequestLine, Method, RequestURI,ParsedHeader,"HTTP/0.9"};
[Method, RequestURI, HTTPVersion] ->
{not_implemented, RequestLine, Method, RequestURI,ParsedHeader, HTTPVersion};
{bad_request, Reason} ->
{bad_request, Reason};
Reason ->
{bad_request, "Unknown request method"}
end.
%%----------------------------------------------------------------------
%% The request is passed through the server as a record of type mod get it
%% ----------------------------------------------------------------------
get_request_record(Socket,SocketType,ConfigDB,Method,RequestURI,
HTTPVersion,RequestLine,ParsedHeader,EntityBody,InitData)->
PersistentConn=get_persistens(HTTPVersion,ParsedHeader,ConfigDB),
Info=#mod{init_data=InitData,
data=[],
socket_type=SocketType,
socket=Socket,
config_db=ConfigDB,
method=Method,
absolute_uri=formatAbsoluteURI(RequestURI,ParsedHeader),
request_uri=formatRequestUri(RequestURI),
http_version=HTTPVersion,
request_line=RequestLine,
parsed_header=ParsedHeader,
entity_body=maybe_remove_nl(ParsedHeader,EntityBody),
connection=PersistentConn},
{ok,Info}.
%%----------------------------------------------------------------------
%% Conmtrol wheater we shall maintain a persistent connection or not
%%----------------------------------------------------------------------
get_persistens(HTTPVersion,ParsedHeader,ConfigDB)->
case httpd_util:lookup(ConfigDB,persistent_conn,true) of
true->
case HTTPVersion of
%%If it is version prio to 1.1 kill the conneciton
[$H, $T, $T, $P, $\/, $1, $.,N] ->
case httpd_util:key1search(ParsedHeader,"connection","keep-alive")of
%%if the connection isn't ordered to go down let it live
%%The keep-alive value is the older http/1.1 might be older
%%Clients that use it.
"keep-alive" when N >= 49 ->
?DEBUG("CONNECTION MODE: ~p",[true]),
true;
"close" ->
?DEBUG("CONNECTION MODE: ~p",[false]),
false;
Connect ->
?DEBUG("CONNECTION MODE: ~p VALUE: ~p",[false,Connect]),
false
end;
_ ->
?DEBUG("CONNECTION MODE: ~p VERSION: ~p",[false,HTTPVersion]),
false
end;
_ ->
false
end.
%%----------------------------------------------------------------------
%% Control whether the last newline of the body is a part of the message or
%%it is a part of the multipart message.
%%----------------------------------------------------------------------
maybe_remove_nl(Header,Rest) ->
case find_content_type(Header) of
false ->
{ok,EntityBody,_}=regexp:sub(Rest,"\r\n\$",""),
EntityBody;
{ok, Value} ->
case string:str(Value, "multipart/form-data") of
0 ->
{ok,EntityBody,_}=regexp:sub(Rest,"\r\n\$",""),
EntityBody;
_ ->
Rest
end
end.
%%----------------------------------------------------------------------
%% Cet the content type of the incomming request
%%----------------------------------------------------------------------
find_content_type([]) ->
false;
find_content_type([{Name,Value}|Tail]) ->
case httpd_util:to_lower(Name) of
"content-type" ->
{ok, Value};
_ ->
find_content_type(Tail)
end.
%%----------------------------------------------------------------------
%% Split the header to a list of strings where each string represents a
%% HTTP header-field
%%----------------------------------------------------------------------
split_lines(Request) ->
split_lines(Request, [], []).
split_lines([], CAcc, Acc) ->
lists:reverse([lists:reverse(CAcc)|Acc]);
%%White space in the header fields are allowed but the new line must begin with LWS se
%%rfc2616 chap 4.2. The rfc do not say what to
split_lines([$\r, $\n, $\t |Rest], CAcc, Acc) ->
split_lines(Rest, [$\r, $\n |CAcc], Acc);
split_lines([$\r, $\n, $\s |Rest], CAcc, Acc) ->
split_lines(Rest, [$\r, $\n |CAcc], Acc);
split_lines([$\r, $\n|Rest], CAcc, Acc) ->
split_lines(Rest, [], [lists:reverse(CAcc)|Acc]);
split_lines([Chr|Rest], CAcc, Acc) ->
split_lines(Rest, [Chr|CAcc], Acc).
%%----------------------------------------------------------------------
%% This is a 'hack' to stop people from trying to access directories/files
%% relative to the ServerRoot.
%%----------------------------------------------------------------------
verify_request([Request, RequestURI]) ->
verify_request([Request, RequestURI, "HTTP/0.9"]);
verify_request([Request, RequestURI, Protocol]) ->
NewRequestURI =
case string:str(RequestURI, "?") of
0 ->
RequestURI;
Ndx ->
string:left(RequestURI, Ndx)
end,
case string:str(NewRequestURI, "..") of
0 ->
[Request, RequestURI, Protocol];
_ ->
{bad_request, {forbidden, RequestURI}}
end;
verify_request(Request) ->
Request.
%%----------------------------------------------------------------------
%% tagup_header
%%
%% Parses the header of a HTTP request and returns a key,value tuple
%% list containing Name and Value of each header directive as of:
%%
%% Content-Type: multipart/mixed -> {"Content-Type", "multipart/mixed"}
%%
%% But in http/1.1 the field-names are case insencitive so now it must be
%% Content-Type: multipart/mixed -> {"content-type", "multipart/mixed"}
%% The standard furthermore says that leading and traling white space
%% is not a part of the fieldvalue and shall therefore be removed.
%%----------------------------------------------------------------------
tagup_header([]) -> [];
tagup_header([Line|Rest]) -> [tag(Line, [])|tagup_header(Rest)].
tag([], Tag) ->
{httpd_util:to_lower(lists:reverse(Tag)), ""};
tag([$:|Rest], Tag) ->
{httpd_util:to_lower(lists:reverse(Tag)), httpd_util:strip(Rest)};
tag([Chr|Rest], Tag) ->
tag(Rest, [Chr|Tag]).
%%----------------------------------------------------------------------
%% There are 3 possible forms of the reuqest URI
%%
%% 1. * When the request is not for a special assset. is is instead
%% to the server itself
%%
%% 2. absoluteURI the whole servername port and asset is in the request
%%
%% 3. The most common form that http/1.0 used abs path that is a path
%% to the requested asset.
%5----------------------------------------------------------------------
formatRequestUri("*")->
"*";
formatRequestUri([$h,$t,$t,$p,$:,$\/,$\/|ServerAndPath]) ->
removeServer(ServerAndPath);
formatRequestUri([$H,$T,$T,$P,$:,$\/,$\/|ServerAndPath]) ->
removeServer(ServerAndPath);
formatRequestUri(ABSPath) ->
ABSPath.
removeServer([$\/|Url])->
case Url of
[]->
"/";
_->
[$\/|Url]
end;
removeServer([N|Url]) ->
removeServer(Url).
formatAbsoluteURI([$h,$t,$t,$p,$:,$\/,$\/|Uri],ParsedHeader)->
[$H,$T,$T,$P,$:,$\/,$\/|Uri];
formatAbsoluteURI([$H,$T,$T,$P,$:,$\/,$\/|Uri],ParsedHeader)->
[$H,$T,$T,$P,$:,$\/,$\/|Uri];
formatAbsoluteURI(Uri,ParsedHeader)->
case httpd_util:key1search(ParsedHeader,"host") of
undefined ->
nohost;
Host ->
Host++Uri
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%Code below is crap from an older version shall be removed when
%%transformation to http/1.1 is finished
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%request(Request) ->
% ?DEBUG("request -> entry with:"
% "~n Request: ~s",[Request]),
% {BeforeEntityBody, Rest} = hsplit([], Request),
% ?DEBUG("request ->"
% "~n BeforeEntityBody: ~p"
% "~n Rest: ~p",[BeforeEntityBody, Rest]),
% [RequestLine|Header] = split_lines(BeforeEntityBody),
% ?DEBUG("request ->"
% "~n RequestLine: ~p"
% "~n Header: ~p",[RequestLine,Header]),
% ParsedHeader = tagup_header(Header),
% ?DEBUG("request ->"
% "~n ParseHeader: ~p",[ParsedHeader]),
% EntityBody = maybe_remove_nl(ParsedHeader,Rest),
% ?DEBUG("request ->"
% "~n EntityBody: ~p",[EntityBody]),
% case verify_request(string:tokens(RequestLine," ")) of
% ["HEAD", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
% {ok, ["HEAD", formatRequestUri(RequestURI), [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
% ParsedHeader, EntityBody]};
% ["GET", RequestURI, "HTTP/0.9"] ->
% {ok, ["GET", RequestURI, "HTTP/0.9", RequestLine, ParsedHeader,
% EntityBody]};
% ["GET", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
% {ok, ["GET", formatRequestUri(RequestURI), [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
% ParsedHeader,EntityBody]};
%% ["POST", RequestURI, [$H,$T,$T,$P,$/,$1,$.,N]] ->
% {ok, ["POST", formatRequestUri(RequestURI), [$H,$T,$T,$P,$/,$1,$.,N], RequestLine,
% ParsedHeader, EntityBody]};
% [Method, RequestURI] ->
% {not_implemented, RequestLine, Method, RequestURI,ParsedHeader,"HTTP/0.9"};
% [Method, RequestURI, HTTPVersion] ->
% {not_implemented, RequestLine, Method, RequestURI,ParsedHeader, HTTPVersion};
% {bad_request, Reason} ->
% {bad_request, Reason};
% Reason ->
% {bad_request, "Unknown request method"}
% end.
hsplit(Accu,[]) ->
{lists:reverse(Accu), []};
hsplit(Accu, [ $\r, $\n, $\r, $\n | Tail]) ->
{lists:reverse(Accu), Tail};
hsplit(Accu, [H|T]) ->
hsplit([H|Accu],T).
