%% @author Justin Sheehy <justin@basho.com>
%% @author Andy Gross <andy@basho.com>
%% @copyright 2007-2008 Basho Technologies
%%
%% @doc Utilities for parsing, quoting, and negotiation.
%% @end
%%
%% 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.
-module(cowmachine_util).
-export([is_valid_header/1, is_valid_header_value/1, valid_location/1]).
-export([parse_qs/1]).
-export([convert_request_date/1]).
-export([choose_media_type_provided/2]).
-export([is_media_type_accepted/2]).
-export([choose_media_type_accepted/2]).
-export([choose_charset/2]).
-export([choose_encoding/2]).
-export([parse_header/1]).
-export([normalize_content_type/1]).
-export([format_content_type/1]).
-export([quoted_string/1]).
-export([split_quoted_strings/1]).
%% @doc Check header valid characters,
%% see <a href="https://www.ietf.org/rfc/rfc822.txt">rfc822</a>
-spec is_valid_header(Header) -> Result when
Header :: binary(),
Result :: boolean().
is_valid_header(<<>>) -> false;
is_valid_header(H) -> is_valid_header_1(H).
-spec is_valid_header_1(Header) -> Result when
Header :: binary(),
Result :: boolean().
is_valid_header_1(<<>>) -> true;
is_valid_header_1(<<$:, _/binary>>) -> false;
is_valid_header_1(<<C, _/binary>>) when C >= $A, C =< $Z -> false;
is_valid_header_1(<<C, R/binary>>) when C >= 33, C =< 126 -> is_valid_header_1(R);
is_valid_header_1(_) -> false.
%% @doc Check if the given value is acceptaple for a http header value.
-spec is_valid_header_value(Header) -> Result when
Header :: binary(),
Result :: boolean().
is_valid_header_value(<<>>) -> true;
is_valid_header_value(<<13, _/binary>>) -> false;
is_valid_header_value(<<10, _/binary>>) -> false;
is_valid_header_value(<<C, R/binary>>) when C =< 127 -> is_valid_header_value(R);
is_valid_header_value(_) -> false.
%% @doc Check if the given location is safe to use as a location header. This is
%% uses as a defense against urls with scripts. The test is quite strict and will
%% drop values that might have been acceptable.
-spec valid_location(Location) -> Result when
Location :: binary(),
Result :: {true, binary()} | false.
valid_location(Location) ->
case is_valid_header_value(Location) of
true ->
case z_html:noscript(Location, false) of
<<"#script-removed">> -> false;
<<>> -> false;
Loc -> {true, Loc}
end;
false ->
false
end.
%% @doc Parse the HTTP date (IMF-fixdate, rfc850, asctime).
-spec convert_request_date(Date) -> Result when
Date :: binary(),
Result :: calendar:datetime().
convert_request_date(Date) ->
try
cow_date:parse_date(Date)
catch
error:_ -> bad_date
end.
%% @doc Match the `Accept' request header with `content_types_provided'.<br/>
%% Return the `Content-Type' for the response.<br/>
%% If there is no acceptable/available match, return the atom `none'.<br/>
%% `AcceptHead' is the value of the request's `Accept' header.<br/>
%% `Provided' is a list of media types the controller can provide:
%% <ul>
%% <li>a binary e.g. — `<<"text/html">>'<br/></li>
%% <li>a binary and parameters e.g. — `{<<"text/html">>,[{<<"level">>,<<"1">>}]}'</li>
%% <li>two binaries e.g. `{<<"text">>, <<"html">>}'</li>
%% <li>two binaries and parameters e.g. — `{<<"text">>,<<"html">>,[{<<"level">>,<<"1">>}]}'</li>
%% </ul>
%% (the plain string case with no parameters is much more common)
-spec choose_media_type_provided(Provided, AcceptHead) -> Result when
Provided :: MediaTypes,
MediaTypes :: [MediaType],
MediaType :: cow_http_hd:media_type(),
AcceptHead :: binary(),
Result :: cow_http_hd:media_type() | none.
choose_media_type_provided(Provided, AcceptHead) when is_list(Provided), is_binary(AcceptHead) ->
Requested = accept_header_to_media_types(AcceptHead),
Prov1 = normalize_provided(Provided),
choose_media_type_provided_1(Prov1, Requested).
-spec choose_media_type_provided_1(Provided, Requested) -> Result when
Provided :: list(),
Requested :: [cow_http_hd:media_type()],
Result :: cow_http_hd:media_type() | none.
choose_media_type_provided_1(_Provided, []) ->
none;
choose_media_type_provided_1(Provided, [H|T]) ->
case media_match_provided(H, Provided) of
none -> choose_media_type_provided_1(Provided, T);
CT -> CT
end.
% @doc Return the first matching content type or the atom `none'.
-spec media_match_provided(MediaTypes, Provided) -> Result when
MediaTypes :: {binary(), binary()} | {binary(), binary()} | any(),
Provided :: list(),
Result :: cow_http_hd:media_type() | none.
media_match_provided(_, []) ->
none;
media_match_provided({<<"*">>, <<"*">>, []}, [H|_]) ->
H;
media_match_provided({TypeA, TypeB, Params}, Provided) ->
case lists:dropwhile(
fun({PT1,PT2,PP}) ->
not (media_type_match(TypeA, TypeB, PT1, PT2)
andalso media_params_match(Params, PP))
end,
Provided)
of
[] -> none;
[M|_] -> M
end.
%% @doc Match the `Content-Type' request header with `content_types_accepted' against.
-spec is_media_type_accepted(ContentTypesAccepted, ContentTypeReqHeader) -> Result when
ContentTypesAccepted :: list(),
ContentTypeReqHeader :: cow_http_hd:media_type(),
Result :: boolean().
is_media_type_accepted([], _ReqHeader) ->
true;
is_media_type_accepted(ContentTypesAccepted, ContentTypeReqHeader) when is_list(ContentTypesAccepted), is_tuple(ContentTypeReqHeader) ->
ContentTypesAccepted1 = normalize_provided(ContentTypesAccepted),
choose_media_type_accepted_1(ContentTypesAccepted1, ContentTypeReqHeader) =/= none.
-spec choose_media_type_accepted(ContentTypesAccepted, ReqHeader) -> Result when
ContentTypesAccepted :: [cowmachine_req:media_type()],
ReqHeader :: cow_http_hd:media_type(),
Result :: cowmachine_req:media_type() | none.
choose_media_type_accepted([], ReqHeader) ->
ReqHeader;
choose_media_type_accepted(ContentTypesAccepted, ContentTypeReqHeader) when is_list(ContentTypesAccepted), is_tuple(ContentTypeReqHeader) ->
ContentTypesAccepted1 = normalize_provided(ContentTypesAccepted),
choose_media_type_accepted_1(ContentTypesAccepted1, ContentTypeReqHeader).
-spec choose_media_type_accepted_1(ContentTypesAccepted, ReqHeader) -> Result when
ContentTypesAccepted :: [cowmachine_req:media_type()],
ReqHeader :: cow_http_hd:media_type(),
Result :: cowmachine_req:media_type() | none.
choose_media_type_accepted_1([], _CTReq) ->
none;
choose_media_type_accepted_1([{A1,A2,APs} = AT|T], {CT1,CT2,CTPs} = CTReq) ->
case media_type_match(A1, A2, CT1, CT2) of
true ->
case media_params_match(CTPs, APs) of
true ->
AT;
false ->
choose_media_type_accepted_1(T, CTReq)
end;
false ->
choose_media_type_accepted_1(T, CTReq)
end.
-spec media_type_match(Req1, Req2, Prov1, Prov2) -> Result when
Req1 :: binary(),
Req2 :: binary(),
Prov1 :: binary(),
Prov2 :: binary(),
Result :: boolean().
media_type_match(Req1, Req2, Req1, Req2) -> true;
media_type_match(<<"*">>, <<"*">>, _Prov1, _Prov2) -> true;
media_type_match(Req1, <<"*">>, Req1, _Prov2) -> true;
media_type_match(_Req1, _Req2, _Prov1, _Prov2) -> false.
%% @doc Match the media parameters. Provided must be a subset of requested.
%% There may not be a type in provided that is not in requested.
-spec media_params_match(ReqList, ProvList) -> Result when
ReqList :: list(),
ProvList :: list(),
Result :: boolean().
media_params_match(_ReqList, []) -> true;
media_params_match(ReqList, ReqList) -> true;
media_params_match(ReqList, ProvList) ->
lists:all(
fun(Prov) ->
lists:member(Prov, ReqList)
end,
ProvList).
% @private
% @doc Given the value of an accept header, produce an ordered list based on the q-values.
% The first result being the highest-priority requested type.
-spec accept_header_to_media_types(HeadVal) -> Result when
HeadVal :: binary(),
Result :: [cow_http_hd:media_type()].
accept_header_to_media_types(HeadVal) ->
try
MTs = cow_http_hd:parse_accept(HeadVal),
Sorted = lists:reverse(lists:keysort(2, MTs)),
[ MType || {MType, _Prio, _Extra} <- Sorted ]
catch
_:_ -> []
end.
-spec normalize_provided(Provided) -> Result when
Provided :: [cowmachine_req:media_type()],
Result :: cow_http_hd:media_type().
normalize_provided(Provided) ->
[ normalize_content_type(X) || X <- Provided ].
-spec normalize_content_type(Type) -> Result when
Type :: cowmachine_req:media_type(),
Result :: cow_http_hd:media_type().
normalize_content_type(Type) when is_binary(Type) ->
cow_http_hd:parse_content_type(Type);
normalize_content_type({Type,Params}) when is_binary(Type), is_list(Params) ->
{T1,T2, _} = cow_http_hd:parse_content_type(Type),
{T1, T2, Params};
normalize_content_type({Type1,Type2}) when is_binary(Type1), is_binary(Type2) ->
{Type1, Type2, []};
normalize_content_type({Type1,Type2,Params}) when is_binary(Type1), is_binary(Type2), is_list(Params) ->
{Type1, Type2, Params}.
-spec format_content_type(MediaType) -> Result when
MediaType :: cow_http_hd:media_type(),
Result :: binary().
format_content_type({T1, T2, []}) ->
<<T1/binary, $/, T2/binary>>;
format_content_type({T1, T2, Params}) ->
ParamsBin = [ [$;, Param, $=, Value] || {Param,Value} <- Params ],
iolist_to_binary([T1, $/, T2, ParamsBin]).
%% @doc Select the best fitting character set or `none'
-spec choose_charset(CSets, AccCharHdr) -> Result when
CSets :: [binary()],
AccCharHdr :: binary(),
Result :: none | binary().
choose_charset(CSets, AccCharHdr) ->
do_choose(CSets, AccCharHdr, <<"utf-8">>).
%% @doc Select the best fitting encoding or `none'
-spec choose_encoding(Encs, AccEncHdr) -> Result when
Encs :: [binary()],
AccEncHdr :: binary(),
Result :: none | binary().
choose_encoding(Encs, AccEncHdr) ->
do_choose(Encs, AccEncHdr, <<"identity">>).
-spec do_choose(Choices, Header, Default) -> Result when
Choices :: [binary()],
Header :: binary(),
Default :: binary(),
Result :: none | binary().
do_choose(Choices, Header, Default) ->
try
Accepted = cow_http_hd:parse_accept_encoding(Header),
Accepted1 = lists:reverse(lists:keysort(2, Accepted)),
DefaultPrio = [P || {C,P} <- Accepted1, C =:= Default],
StarPrio = [P || {C,P} <- Accepted1, C =:= <<"*">>],
DefaultOkay = case DefaultPrio of
[] ->
case StarPrio of
[0] -> no;
_ -> yes
end;
[0] -> no;
_ -> yes
end,
AnyOkay = case StarPrio of
[] -> no;
[0] -> no;
_ -> yes
end,
do_choose(Default, DefaultOkay, AnyOkay, Choices, Accepted)
catch
_:_ ->
Default
end.
-spec do_choose(Default, DefaultOkay, AnyOkay, Choices, Accepted) -> Result when
Default :: binary(),
DefaultOkay :: yes | no,
AnyOkay :: yes | no,
Choices :: list(),
Accepted :: list(),
Result :: binary() | none.
do_choose(_Default, _DefaultOkay, _AnyOkay, [], _Accepted) ->
none;
do_choose(_Default, _DefaultOkay, yes, [Choice|_], []) ->
Choice;
do_choose(Default, yes, no, Choices, []) ->
case lists:member(Default, Choices) of
true -> Default;
_ -> none
end;
do_choose(_Default, no, no, _Choices, []) ->
none;
do_choose(Default, DefaultOkay, AnyOkay, Choices, [{Acc,0}|AccRest]) ->
do_choose(Default, DefaultOkay, AnyOkay, lists:delete(Acc, Choices), AccRest);
do_choose(Default, DefaultOkay, AnyOkay, Choices, [{Acc,_Prio}|AccRest]) ->
case lists:member(Acc, Choices) of
true -> Acc;
false -> do_choose(Default, DefaultOkay, AnyOkay, Choices, AccRest)
end.
%% The percent decoding is inlined to greatly improve the performance
%% by avoiding copying binaries twice (once for extracting, once for
%% decoding) instead of just extracting the proper representation.
%%
%% Copyright (c) 2013-2015, Loïc Hoguin <essen@ninenines.eu>
%%
%% Permission to use, copy, modify, and/or distribute this software for any
%% purpose with or without fee is hereby granted, provided that the above
%% copyright notice and this permission notice appear in all copies.
%%
%% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
%% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
%% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
%% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
%% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
%% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
%% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
%%
%% @doc Parse an `application/x-www-form-urlencoded' string.<br/>
%% See also <a href="https://www.w3.org/TR/html401/interact/forms.html#didx-applicationx-www-form-urlencoded">specification</a>.
-spec parse_qs(String) -> Result when
String :: binary(),
Result :: list({binary(),binary()}).
parse_qs(<<>>) ->
[];
parse_qs(Qs) ->
parse_qs_name(Qs, [], <<>>).
%% @throws invalid_percent_encoding
-spec parse_qs_name(String, Acc, Name) -> Result when
String :: binary(),
Acc :: list(),
Name :: binary(),
Result :: list({binary(),binary()}).
parse_qs_name(<< $%, H, L, Rest/binary >>, Acc, Name) ->
C = (unhex(H) bsl 4 bor unhex(L)),
parse_qs_name(Rest, Acc, << Name/binary, C >>);
parse_qs_name(<< $+, Rest/binary >>, Acc, Name) ->
parse_qs_name(Rest, Acc, << Name/binary, " " >>);
parse_qs_name(<< $=, _/binary >>, _Acc, <<>>) ->
throw(invalid_qs_name);
parse_qs_name(<< $=, Rest/binary >>, Acc, Name) ->
parse_qs_value(Rest, Acc, Name, <<>>);
parse_qs_name(<< $&, Rest/binary >>, Acc, Name) ->
case Name of
<<>> -> parse_qs_name(Rest, Acc, <<>>);
_ -> parse_qs_name(Rest, [{Name, <<>>}|Acc], <<>>)
end;
parse_qs_name(<< C, Rest/binary >>, Acc, Name) when C =/= $% ->
parse_qs_name(Rest, Acc, << Name/binary, C >>);
parse_qs_name(<<>>, Acc, Name) ->
case Name of
<<>> -> lists:reverse(Acc);
_ -> lists:reverse([{Name, <<>>}|Acc])
end;
parse_qs_name(_Rest, _Acc, _Name) ->
throw(invalid_percent_encoding).
%% @throws invalid_percent_encoding
-spec parse_qs_value(String, Acc, Name, Value) -> Result when
String :: binary(),
Acc :: list(),
Name :: binary(),
Value :: binary(),
Result :: list({binary(),binary()}).
parse_qs_value(<< $%, H, L, Rest/binary >>, Acc, Name, Value) ->
C = (unhex(H) bsl 4 bor unhex(L)),
parse_qs_value(Rest, Acc, Name, << Value/binary, C >>);
parse_qs_value(<< $+, Rest/binary >>, Acc, Name, Value) ->
parse_qs_value(Rest, Acc, Name, << Value/binary, " " >>);
parse_qs_value(<< $&, Rest/binary >>, Acc, Name, Value) ->
parse_qs_name(Rest, [{Name, Value}|Acc], <<>>);
parse_qs_value(<< C, Rest/binary >>, Acc, Name, Value) when C =/= $% ->
parse_qs_value(Rest, Acc, Name, << Value/binary, C >>);
parse_qs_value(<<>>, Acc, Name, Value) ->
lists:reverse([{Name, Value}|Acc]);
parse_qs_value(_Rest, _Acc, _Name, _Value) ->
throw(invalid_percent_encoding).
%% @throws invalid_percent_encoding
-spec unhex(Char) -> Result when
Char :: char(),
Result :: 1..15.
unhex($0) -> 0;
unhex($1) -> 1;
unhex($2) -> 2;
unhex($3) -> 3;
unhex($4) -> 4;
unhex($5) -> 5;
unhex($6) -> 6;
unhex($7) -> 7;
unhex($8) -> 8;
unhex($9) -> 9;
unhex($A) -> 10;
unhex($B) -> 11;
unhex($C) -> 12;
unhex($D) -> 13;
unhex($E) -> 14;
unhex($F) -> 15;
unhex($a) -> 10;
unhex($b) -> 11;
unhex($c) -> 12;
unhex($d) -> 13;
unhex($e) -> 14;
unhex($f) -> 15;
unhex(_) -> throw(invalid_percent_encoding).
%% author Bob Ippolito <bob@mochimedia.com>
%% copyright 2007 Mochi Media, Inc.
%% @doc Parse a Content-Type like header, return the main Content-Type
%% and a property list of options.
-spec parse_header(String) -> Result when
String :: binary(),
Result :: {binary(), list({binary(),binary()})}.
parse_header(String) ->
%% TODO: This is exactly as broken as Python's cgi module.
%% Should parse properly like mochiweb_cookies.
[Type | Parts] = [z_string:trim(S) || S <- binary:split(String, <<";">>, [global])],
F = fun (S, Acc) ->
case binary:split(S, <<"=">>) of
[_] -> Acc;
[<<>>, _] -> Acc;
[_, <<>>] -> Acc;
[Name, Value] ->
[{z_string:to_lower(z_string:trim(Name)), unquote_header(z_string:trim(Value))} | Acc]
end
end,
{z_string:to_lower(Type), lists:foldr(F, [], Parts)}.
-spec unquote_header(Header) -> Result when
Header :: binary(),
Result :: binary().
unquote_header(<<$", Rest/binary>>) ->
unquote_header(Rest, <<>>);
unquote_header(S) ->
S.
-spec unquote_header(Header, Acc) -> Result when
Header :: binary(),
Acc :: binary(),
Result :: binary().
unquote_header(<<>>, Acc) -> Acc;
unquote_header(<<$">>, Acc) -> Acc;
unquote_header(<<$\\, C, Rest/binary>>, Acc) ->
unquote_header(Rest, <<Acc/binary, C>>);
unquote_header(<<C, Rest/binary>>, Acc) ->
unquote_header(Rest, <<Acc/binary, C>>).
-spec quoted_string(String) -> Result when
String :: binary(),
Result :: binary().
quoted_string(<<$", _Rest/binary>> = Str) ->
Str;
quoted_string(Str) ->
escape_quotes(Str, <<$">>). % Initialize Acc with opening quote
-spec escape_quotes(String, Acc) -> Result when
String :: binary(),
Acc :: binary(),
Result :: binary().
escape_quotes(<<>>, Acc) ->
<<Acc/binary, $">>; % Append final quote
escape_quotes(<<$\\, Char, Rest/binary>>, Acc) ->
escape_quotes(Rest, <<Acc/binary, $\\, Char>>); % Any quoted char should be skipped
escape_quotes(<<$", Rest/binary>>, Acc) ->
escape_quotes(Rest, <<Acc/binary, $\\, $">>); % Unquoted quotes should be escaped
escape_quotes(<<Char, Rest/binary>>, Acc) ->
escape_quotes(Rest, <<Acc/binary, Char>>).
-spec split_quoted_strings(String) -> Result when
String :: binary(),
Result :: [binary()].
split_quoted_strings(Str) ->
split_quoted_strings(Str, []).
-spec split_quoted_strings(String, Acc) -> Result when
String :: binary(),
Acc :: [binary()],
Result :: [binary()].
split_quoted_strings(<<>>, Acc) ->
lists:reverse(Acc);
split_quoted_strings(<<$", Rest/binary>>, Acc) ->
{Str, Cont} = unescape_quoted_string(Rest, <<>>),
split_quoted_strings(Cont, [Str | Acc]);
split_quoted_strings(<<_Skip, Rest/binary>>, Acc) ->
split_quoted_strings(Rest, Acc).
-spec unescape_quoted_string(String, Acc) -> Result when
String :: binary(),
Acc :: bitstring(),
Result :: {bitstring(),binary()}.
unescape_quoted_string(<<>>, Acc) ->
{Acc, <<>>};
unescape_quoted_string(<<$\\, Char, Rest/binary>>, Acc) -> % Any quoted char should be unquoted
unescape_quoted_string(Rest, <<Acc/binary, Char>>);
unescape_quoted_string(<<$", Rest/binary>>, Acc) -> % Quote indicates end of this string
{Acc, Rest};
unescape_quoted_string(<<Char, Rest/binary>>, Acc) ->
unescape_quoted_string(Rest, <<Acc/binary, Char>>).
