Subversion Repositories SE.SVN

%% @author Emad El-Haraty <emad@mochimedia.com>

%% @copyright 2007 Mochi Media, Inc.

%%

%% Permission is hereby granted, free of charge, to any person obtaining a

%% copy of this software and associated documentation files (the "Software"),

%% to deal in the Software without restriction, including without limitation

%% the rights to use, copy, modify, merge, publish, distribute, sublicense,

%% and/or sell copies of the Software, and to permit persons to whom the

%% Software is furnished to do so, subject to the following conditions:

%%

%% The above copyright notice and this permission notice shall be included in

%% all copies or substantial portions of the Software.

%%

%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

%% IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

%% FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL

%% THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

%% LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING

%% FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER

%% DEALINGS IN THE SOFTWARE.

%% @doc HTTP Cookie parsing and generating (RFC 2109, RFC 2965).

-module(mochiweb_cookies).

-export([parse_cookie/1, cookie/3, cookie/2]).

-define(QUOTE, $\").

-define(IS_WHITESPACE(C),

        (C =:= $\s orelse C =:= $\t orelse C =:= $\r orelse C =:= $\n)).

%% RFC 2616 separators (called tspecials in RFC 2068)

-define(IS_SEPARATOR(C),

        (C < 32 orelse

         C =:= $\s orelse C =:= $\t orelse

         C =:= $( orelse C =:= $) orelse C =:= $< orelse C =:= $> orelse

         C =:= $@ orelse C =:= $, orelse C =:= $; orelse C =:= $: orelse

         C =:= $\\ orelse C =:= $\" orelse C =:= $/ orelse

         C =:= $[ orelse C =:= $] orelse C =:= $? orelse C =:= $= orelse

         C =:= ${ orelse C =:= $})).

%% RFC 6265 cookie value allowed characters

%%  cookie-octet      = %x21 / %x23-2B / %x2D-3A / %x3C-5B / %x5D-7E

%%                        ; US-ASCII characters excluding CTLs,

%%                        ; whitespace DQUOTE, comma, semicolon,

%%                        ; and backslash

-define(IS_COOKIE_OCTET(C),

        (C =:= 16#21

         orelse (C >= 16#23 andalso C =< 16#2B)

         orelse (C >= 16#2D andalso C =< 16#3A)

         orelse (C >= 16#3C andalso C =< 16#5B)

         orelse (C >= 16#5D andalso C =< 16#7E)

        )).

%% @type proplist() = [{Key::string(), Value::string()}].

%% @type header() = {Name::string(), Value::string()}.

%% @type int_seconds() = integer().

%% @spec cookie(Key::string(), Value::string()) -> header()

%% @doc Short-hand for <code>cookie(Key, Value, [])</code>.

cookie(Key, Value) ->

    cookie(Key, Value, []).

%% @spec cookie(Key::string(), Value::string(), Options::[Option]) -> header()

%% where Option = {max_age, int_seconds()} | {local_time, {date(), time()}}

%%                | {domain, string()} | {path, string()}

%%                | {secure, true | false} | {http_only, true | false}

%%                | {same_site, lax | strict | none}

%%

%% @doc Generate a Set-Cookie header field tuple.

cookie(Key, Value, Options) ->

    Cookie = [any_to_list(Key), "=", quote(Value), "; Version=1"],

    %% Set-Cookie:

    %%    Comment, Domain, Max-Age, Path, Secure, Version

    %% Set-Cookie2:

    %%    Comment, CommentURL, Discard, Domain, Max-Age, Path, Port, Secure,

    %%    Version

    ExpiresPart =

        case proplists:get_value(max_age, Options) of

            undefined ->

                "";

            RawAge ->

                When = case proplists:get_value(local_time, Options) of

                           undefined ->

                               calendar:local_time();

                           LocalTime ->

                               LocalTime

                       end,

                Age = case RawAge < 0 of

                          true ->

                              0;

                          false ->

                              RawAge

                      end,

                ["; Expires=", age_to_cookie_date(Age, When),

                 "; Max-Age=", quote(Age)]

        end,

    SecurePart =

        case proplists:get_value(secure, Options) of

            true ->

                "; Secure";

            _ ->

                ""

        end,

    DomainPart =

        case proplists:get_value(domain, Options) of

            undefined ->

                "";

            Domain ->

                ["; Domain=", quote(Domain)]

        end,

    PathPart =

        case proplists:get_value(path, Options) of

            undefined ->

                "";

            Path ->

                ["; Path=", quote(Path)]

        end,

    HttpOnlyPart =

        case proplists:get_value(http_only, Options) of

            true ->

                "; HttpOnly";

            _ ->

                ""

        end,

    SameSitePart =

        case proplists:get_value(same_site, Options) of

            undefined ->

                "";

            lax ->

                "; SameSite=Lax";

            strict ->

                "; SameSite=Strict";

            none ->

                "; SameSite=None"

        end,

    CookieParts = [Cookie, ExpiresPart, SecurePart, DomainPart, PathPart,

        HttpOnlyPart, SameSitePart],

    {"Set-Cookie", lists:flatten(CookieParts)}.

%% Every major browser incorrectly handles quoted strings in a

%% different and (worse) incompatible manner.  Instead of wasting time

%% writing redundant code for each browser, we restrict cookies to

%% only contain characters that browsers handle compatibly.

%%

%% By replacing the definition of quote with this, we generate

%% RFC-compliant cookies:

%%

%%     quote(V) ->

%%         Fun = fun(?QUOTE, Acc) -> [$\\, ?QUOTE | Acc];

%%                  (Ch, Acc) -> [Ch | Acc]

%%               end,

%%         [?QUOTE | lists:foldr(Fun, [?QUOTE], V)].

%% Convert to a string and raise an error if quoting is required.

quote(V0) ->

    V = any_to_list(V0),

    lists:all(fun(Ch) -> Ch =:= $/ orelse not ?IS_SEPARATOR(Ch) end, V)

        orelse erlang:error({cookie_quoting_required, V}),

    V.

%% Return a date in the form of: Wdy, DD-Mon-YYYY HH:MM:SS GMT

%% See also: rfc2109: 10.1.2

rfc2109_cookie_expires_date(LocalTime) ->

    {{YYYY,MM,DD},{Hour,Min,Sec}} =

        case calendar:local_time_to_universal_time_dst(LocalTime) of

            [] ->

                {Date, {Hour1, Min1, Sec1}} = LocalTime,

                LocalTime2 = {Date, {Hour1 + 1, Min1, Sec1}},

                case calendar:local_time_to_universal_time_dst(LocalTime2) of

                    [Gmt]   -> Gmt;

                    [_,Gmt] -> Gmt

                end;

            [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",

                    [httpd_util:day(DayNumber),DD,httpd_util:month(MM),YYYY,Hour,Min,Sec])).

add_seconds(Secs, LocalTime) ->

    Greg = calendar:datetime_to_gregorian_seconds(LocalTime),

    calendar:gregorian_seconds_to_datetime(Greg + Secs).

age_to_cookie_date(Age, LocalTime) ->

    rfc2109_cookie_expires_date(add_seconds(Age, LocalTime)).

%% @spec parse_cookie(string()) -> [{K::string(), V::string()}]

%% @doc Parse the contents of a Cookie header field, ignoring cookie

%% attributes, and return a simple property list.

parse_cookie("") ->

    [];

parse_cookie(Cookie) ->

    parse_cookie(Cookie, []).

%% Internal API

parse_cookie([], Acc) ->

    lists:reverse(Acc);

parse_cookie(String, Acc) ->

    {{Token, Value}, Rest} = read_pair(String),

    Acc1 = case Token of

               "" ->

                   Acc;

               "$" ++ _ ->

                   Acc;

               _ ->

                   [{Token, Value} | Acc]

           end,

    parse_cookie(Rest, Acc1).

read_pair(String) ->

    {Token, Rest} = read_token(skip_whitespace(String)),

    {Value, Rest1} = read_value(skip_whitespace(Rest)),

    {{Token, Value}, skip_past_separator(Rest1)}.

read_value([$= | Value]) ->

    Value1 = skip_whitespace(Value),

    case Value1 of

        [?QUOTE | _] ->

            read_quoted(Value1);

        _ ->

            read_value_(Value1)

    end;

read_value(String) ->

    {"", String}.

read_value_(String) ->

    F = fun (C) -> ?IS_COOKIE_OCTET(C) end,

    lists:splitwith(F, String).

read_quoted([?QUOTE | String]) ->

    read_quoted(String, []).

read_quoted([], Acc) ->

    {lists:reverse(Acc), []};

read_quoted([?QUOTE | Rest], Acc) ->

    {lists:reverse(Acc), Rest};

read_quoted([$\\, Any | Rest], Acc) ->

    read_quoted(Rest, [Any | Acc]);

read_quoted([C | Rest], Acc) ->

    read_quoted(Rest, [C | Acc]).

skip_whitespace(String) ->

    F = fun (C) -> ?IS_WHITESPACE(C) end,

    lists:dropwhile(F, String).

read_token(String) ->

    F = fun (C) -> not ?IS_SEPARATOR(C) end,

    lists:splitwith(F, String).

skip_past_separator([]) ->

    [];

skip_past_separator([$; | Rest]) ->

    Rest;

skip_past_separator([$, | Rest]) ->

    Rest;

skip_past_separator([_ | Rest]) ->

    skip_past_separator(Rest).

any_to_list(V) when is_list(V) ->

    V;

any_to_list(V) when is_atom(V) ->

    atom_to_list(V);

any_to_list(V) when is_binary(V) ->

    binary_to_list(V);

any_to_list(V) when is_integer(V) ->

    integer_to_list(V).

%%

%% Tests

%%

-ifdef(TEST).

-include_lib("eunit/include/eunit.hrl").

quote_test() ->

    %% ?assertError eunit macro is not compatible with coverage module

    try quote(":wq")

    catch error:{cookie_quoting_required, ":wq"} -> ok

    end,

    ?assertEqual(

       "foo",

       quote(foo)),

    ok.

parse_cookie_test() ->

    %% RFC example

    C1 = "$Version=\"1\"; Customer=\"WILE_E_COYOTE\"; $Path=\"/acme\";

    Part_Number=\"Rocket_Launcher_0001\"; $Path=\"/acme\";

    Shipping=\"FedEx\"; $Path=\"/acme\"",

    ?assertEqual(

       [{"Customer","WILE_E_COYOTE"},

        {"Part_Number","Rocket_Launcher_0001"},

        {"Shipping","FedEx"}],

       parse_cookie(C1)),

    %% Potential edge cases

    ?assertEqual(

       [{"foo", "x"}],

       parse_cookie("foo=\"\\x\"")),

    ?assertEqual(

       [],

       parse_cookie("=")),

    ?assertEqual(

       [{"foo", ""}, {"bar", ""}],

       parse_cookie("  foo ; bar  ")),

    ?assertEqual(

       [{"foo", ""}, {"bar", ""}],

       parse_cookie("foo=;bar=")),

    ?assertEqual(

       [{"foo", "\";"}, {"bar", ""}],

       parse_cookie("foo = \"\\\";\";bar ")),

    ?assertEqual(

       [{"foo", "\";bar"}],

       parse_cookie("foo=\"\\\";bar")),

    ?assertEqual(

       [],

       parse_cookie([])),

    ?assertEqual(

       [{"foo", "bar"}, {"baz", "wibble"}],

       parse_cookie("foo=bar , baz=wibble ")),

    ?assertEqual(

       [{"foo", "base64=="}, {"bar", "base64="}],

       parse_cookie("foo=\"base64==\";bar=\"base64=\"")),

    ?assertEqual(

       [{"foo", "base64=="}, {"bar", "base64="}],

       parse_cookie("foo=base64==;bar=base64=")),

    ok.

domain_test() ->

    ?assertEqual(

       {"Set-Cookie",

        "Customer=WILE_E_COYOTE; "

        "Version=1; "

        "Domain=acme.com; "

        "HttpOnly"},

       cookie("Customer", "WILE_E_COYOTE",

              [{http_only, true}, {domain, "acme.com"}])),

    ok.

local_time_test() ->

    {"Set-Cookie", S} = cookie("Customer", "WILE_E_COYOTE",

                               [{max_age, 111}, {secure, true}]),

    ?assertMatch(

       ["Customer=WILE_E_COYOTE",

        " Version=1",

        " Expires=" ++ _,

        " Max-Age=111",

        " Secure"],

       string:tokens(S, ";")),

    ok.

cookie_test() ->

    C1 = {"Set-Cookie",

          "Customer=WILE_E_COYOTE; "

          "Version=1; "

          "Path=/acme"},

    C1 = cookie("Customer", "WILE_E_COYOTE", [{path, "/acme"}]),

    C1 = cookie("Customer", "WILE_E_COYOTE",

                [{path, "/acme"}, {badoption, "negatory"}]),

    C1 = cookie('Customer', 'WILE_E_COYOTE', [{path, '/acme'}]),

    C1 = cookie(<<"Customer">>, <<"WILE_E_COYOTE">>, [{path, <<"/acme">>}]),

    {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey", []),

    {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey"),

    LocalTime = calendar:universal_time_to_local_time({{2007, 5, 15}, {13, 45, 33}}),

    C2 = {"Set-Cookie",

          "Customer=WILE_E_COYOTE; "

          "Version=1; "

          "Expires=Tue, 15-May-2007 13:45:33 GMT; "

          "Max-Age=0"},

    C2 = cookie("Customer", "WILE_E_COYOTE",

                [{max_age, -111}, {local_time, LocalTime}]),

    C3 = {"Set-Cookie",

          "Customer=WILE_E_COYOTE; "

          "Version=1; "

          "Expires=Wed, 16-May-2007 13:45:50 GMT; "

          "Max-Age=86417"},

    C3 = cookie("Customer", "WILE_E_COYOTE",

                [{max_age, 86417}, {local_time, LocalTime}]),

    % test various values for SameSite

    %

    % unset default to nothing

    C4 = {"Set-Cookie","i=test123; Version=1"},

    C4 = cookie("i", "test123", []),

    C5 = {"Set-Cookie","i=test123; Version=1; SameSite=Strict"},

    C5 = cookie("i", "test123", [ {same_site, strict}]),

    C6 = {"Set-Cookie","i=test123; Version=1; SameSite=Lax"},

    C6 = cookie("i", "test123", [ {same_site, lax}]),

    C7 = {"Set-Cookie","i=test123; Version=1; SameSite=None"},

    C7 = cookie("i", "test123", [ {same_site, none}]),

    ok.

-endif.