/deps/mochiweb/src/mochiweb_cookies.erl

  1%% @author Emad El-Haraty <emad@mochimedia.com>
  2%% @copyright 2007 Mochi Media, Inc.
  3
  4%% @doc HTTP Cookie parsing and generating (RFC 2109, RFC 2965).
  5
  6-module(mochiweb_cookies).
  7-export([parse_cookie/1, cookie/3, cookie/2]).
  8
  9-define(QUOTE, $\").
 10
 11-define(IS_WHITESPACE(C),
 12        (C =:= $\s orelse C =:= $\t orelse C =:= $\r orelse C =:= $\n)).
 13
 14%% RFC 2616 separators (called tspecials in RFC 2068)
 15-define(IS_SEPARATOR(C),
 16        (C < 32 orelse
 17         C =:= $\s orelse C =:= $\t orelse
 18         C =:= $( orelse C =:= $) orelse C =:= $< orelse C =:= $> orelse
 19         C =:= $@ orelse C =:= $, orelse C =:= $; orelse C =:= $: orelse
 20         C =:= $\\ orelse C =:= $\" orelse C =:= $/ orelse
 21         C =:= $[ orelse C =:= $] orelse C =:= $? orelse C =:= $= orelse
 22         C =:= ${ orelse C =:= $})).
 23
 24%% @type proplist() = [{Key::string(), Value::string()}].
 25%% @type header() = {Name::string(), Value::string()}.
 26%% @type int_seconds() = integer().
 27
 28%% @spec cookie(Key::string(), Value::string()) -> header()
 29%% @doc Short-hand for <code>cookie(Key, Value, [])</code>.
 30cookie(Key, Value) ->
 31    cookie(Key, Value, []).
 32
 33%% @spec cookie(Key::string(), Value::string(), Options::[Option]) -> header()
 34%% where Option = {max_age, int_seconds()} | {local_time, {date(), time()}}
 35%%                | {domain, string()} | {path, string()}
 36%%                | {secure, true | false} | {http_only, true | false}
 37%%
 38%% @doc Generate a Set-Cookie header field tuple.
 39cookie(Key, Value, Options) ->
 40    Cookie = [any_to_list(Key), "=", quote(Value), "; Version=1"],
 41    %% Set-Cookie:
 42    %%    Comment, Domain, Max-Age, Path, Secure, Version
 43    %% Set-Cookie2:
 44    %%    Comment, CommentURL, Discard, Domain, Max-Age, Path, Port, Secure,
 45    %%    Version
 46    ExpiresPart =
 47        case proplists:get_value(max_age, Options) of
 48            undefined ->
 49                "";
 50            RawAge ->
 51                When = case proplists:get_value(local_time, Options) of
 52                           undefined ->
 53                               calendar:local_time();
 54                           LocalTime ->
 55                               LocalTime
 56                       end,
 57                Age = case RawAge < 0 of
 58                          true ->
 59                              0;
 60                          false ->
 61                              RawAge
 62                      end,
 63                ["; Expires=", age_to_cookie_date(Age, When),
 64                 "; Max-Age=", quote(Age)]
 65        end,
 66    SecurePart =
 67        case proplists:get_value(secure, Options) of
 68            true ->
 69                "; Secure";
 70            _ ->
 71                ""
 72        end,
 73    DomainPart =
 74        case proplists:get_value(domain, Options) of
 75            undefined ->
 76                "";
 77            Domain ->
 78                ["; Domain=", quote(Domain)]
 79        end,
 80    PathPart =
 81        case proplists:get_value(path, Options) of
 82            undefined ->
 83                "";
 84            Path ->
 85                ["; Path=", quote(Path)]
 86        end,
 87    HttpOnlyPart =
 88        case proplists:get_value(http_only, Options) of
 89            true ->
 90                "; HttpOnly";
 91            _ ->
 92                ""
 93        end,
 94    CookieParts = [Cookie, ExpiresPart, SecurePart, DomainPart, PathPart, HttpOnlyPart],
 95    {"Set-Cookie", lists:flatten(CookieParts)}.
 96
 97
 98%% Every major browser incorrectly handles quoted strings in a
 99%% different and (worse) incompatible manner.  Instead of wasting time
100%% writing redundant code for each browser, we restrict cookies to
101%% only contain characters that browsers handle compatibly.
102%%
103%% By replacing the definition of quote with this, we generate
104%% RFC-compliant cookies:
105%%
106%%     quote(V) ->
107%%         Fun = fun(?QUOTE, Acc) -> [$\\, ?QUOTE | Acc];
108%%                  (Ch, Acc) -> [Ch | Acc]
109%%               end,
110%%         [?QUOTE | lists:foldr(Fun, [?QUOTE], V)].
111
112%% Convert to a string and raise an error if quoting is required.
113quote(V0) ->
114    V = any_to_list(V0),
115    lists:all(fun(Ch) -> Ch =:= $/ orelse not ?IS_SEPARATOR(Ch) end, V)
116        orelse erlang:error({cookie_quoting_required, V}),
117    V.
118
119add_seconds(Secs, LocalTime) ->
120    Greg = calendar:datetime_to_gregorian_seconds(LocalTime),
121    calendar:gregorian_seconds_to_datetime(Greg + Secs).
122
123
124%% Return a date in the form of: Wdy, DD-Mon-YYYY HH:MM:SS GMT
125%% See also: rfc2109: 10.1.2 
126rfc2109_cookie_expires_date(LocalTime) ->
127    {{YYYY,MM,DD},{Hour,Min,Sec}} =
128        case calendar:local_time_to_universal_time_dst(LocalTime) of
129            [Gmt]   -> Gmt;
130            [_,Gmt] -> Gmt
131        end,
132    DayNumber = calendar:day_of_the_week({YYYY,MM,DD}),
133    lists:flatten(
134      io_lib:format("~s, ~2.2.0w-~3.s-~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
135                    [httpd_util:day(DayNumber),DD,httpd_util:month(MM),YYYY,Hour,Min,Sec])).
136
137age_to_cookie_date(Age, LocalTime) ->
138    rfc2109_cookie_expires_date(add_seconds(Age, LocalTime)).
139
140%% @spec parse_cookie(string()) -> [{K::string(), V::string()}]
141%% @doc Parse the contents of a Cookie header field, ignoring cookie
142%% attributes, and return a simple property list.
143parse_cookie("") ->
144    [];
145parse_cookie(Cookie) ->
146    parse_cookie(Cookie, []).
147
148%% Internal API
149
150parse_cookie([], Acc) ->
151    lists:reverse(Acc);
152parse_cookie(String, Acc) ->
153    {{Token, Value}, Rest} = read_pair(String),
154    Acc1 = case Token of
155               "" ->
156                   Acc;
157               "$" ++ _ ->
158                   Acc;
159               _ ->
160                   [{Token, Value} | Acc]
161           end,
162    parse_cookie(Rest, Acc1).
163
164read_pair(String) ->
165    {Token, Rest} = read_token(skip_whitespace(String)),
166    {Value, Rest1} = read_value(skip_whitespace(Rest)),
167    {{Token, Value}, skip_past_separator(Rest1)}.
168
169read_value([$= | Value]) ->
170    Value1 = skip_whitespace(Value),
171    case Value1 of
172        [?QUOTE | _] ->
173            read_quoted(Value1);
174        _ ->
175            read_token(Value1)
176    end;
177read_value(String) ->
178    {"", String}.
179
180read_quoted([?QUOTE | String]) ->
181    read_quoted(String, []).
182
183read_quoted([], Acc) ->
184    {lists:reverse(Acc), []};
185read_quoted([?QUOTE | Rest], Acc) ->
186    {lists:reverse(Acc), Rest};
187read_quoted([$\\, Any | Rest], Acc) ->
188    read_quoted(Rest, [Any | Acc]);
189read_quoted([C | Rest], Acc) ->
190    read_quoted(Rest, [C | Acc]).
191
192skip_whitespace(String) ->
193    F = fun (C) -> ?IS_WHITESPACE(C) end,
194    lists:dropwhile(F, String).
195
196read_token(String) ->
197    F = fun (C) -> not ?IS_SEPARATOR(C) end,
198    lists:splitwith(F, String).
199
200skip_past_separator([]) ->
201    [];
202skip_past_separator([$; | Rest]) ->
203    Rest;
204skip_past_separator([$, | Rest]) ->
205    Rest;
206skip_past_separator([_ | Rest]) ->
207    skip_past_separator(Rest).
208
209any_to_list(V) when is_list(V) ->
210    V;
211any_to_list(V) when is_atom(V) ->
212    atom_to_list(V);
213any_to_list(V) when is_binary(V) ->
214    binary_to_list(V);
215any_to_list(V) when is_integer(V) ->
216    integer_to_list(V).
217
218%%
219%% Tests
220%%
221-ifdef(TEST).
222-include_lib("eunit/include/eunit.hrl").
223
224quote_test() ->
225    %% ?assertError eunit macro is not compatible with coverage module
226    try quote(":wq")
227    catch error:{cookie_quoting_required, ":wq"} -> ok
228    end,
229    ?assertEqual(
230       "foo",
231       quote(foo)),
232    ok.
233
234parse_cookie_test() ->
235    %% RFC example
236    C1 = "$Version=\"1\"; Customer=\"WILE_E_COYOTE\"; $Path=\"/acme\";
237    Part_Number=\"Rocket_Launcher_0001\"; $Path=\"/acme\";
238    Shipping=\"FedEx\"; $Path=\"/acme\"",
239    ?assertEqual(
240       [{"Customer","WILE_E_COYOTE"},
241        {"Part_Number","Rocket_Launcher_0001"},
242        {"Shipping","FedEx"}],
243       parse_cookie(C1)),
244    %% Potential edge cases
245    ?assertEqual(
246       [{"foo", "x"}],
247       parse_cookie("foo=\"\\x\"")),
248    ?assertEqual(
249       [],
250       parse_cookie("=")),
251    ?assertEqual(
252       [{"foo", ""}, {"bar", ""}],
253       parse_cookie("  foo ; bar  ")),
254    ?assertEqual(
255       [{"foo", ""}, {"bar", ""}],
256       parse_cookie("foo=;bar=")),
257    ?assertEqual(
258       [{"foo", "\";"}, {"bar", ""}],
259       parse_cookie("foo = \"\\\";\";bar ")),
260    ?assertEqual(
261       [{"foo", "\";bar"}],
262       parse_cookie("foo=\"\\\";bar")),
263    ?assertEqual(
264       [],
265       parse_cookie([])),
266    ?assertEqual(
267       [{"foo", "bar"}, {"baz", "wibble"}],
268       parse_cookie("foo=bar , baz=wibble ")),
269    ok.
270
271domain_test() ->
272    ?assertEqual(
273       {"Set-Cookie",
274        "Customer=WILE_E_COYOTE; "
275        "Version=1; "
276        "Domain=acme.com; "
277        "HttpOnly"},
278       cookie("Customer", "WILE_E_COYOTE",
279              [{http_only, true}, {domain, "acme.com"}])),
280    ok.
281
282local_time_test() ->
283    {"Set-Cookie", S} = cookie("Customer", "WILE_E_COYOTE",
284                               [{max_age, 111}, {secure, true}]),
285    ?assertMatch(
286       ["Customer=WILE_E_COYOTE",
287        " Version=1",
288        " Expires=" ++ _,
289        " Max-Age=111",
290        " Secure"],
291       string:tokens(S, ";")),
292    ok.
293
294cookie_test() ->
295    C1 = {"Set-Cookie",
296          "Customer=WILE_E_COYOTE; "
297          "Version=1; "
298          "Path=/acme"},
299    C1 = cookie("Customer", "WILE_E_COYOTE", [{path, "/acme"}]),
300    C1 = cookie("Customer", "WILE_E_COYOTE",
301                [{path, "/acme"}, {badoption, "negatory"}]),
302    C1 = cookie('Customer', 'WILE_E_COYOTE', [{path, '/acme'}]),
303    C1 = cookie(<<"Customer">>, <<"WILE_E_COYOTE">>, [{path, <<"/acme">>}]),
304
305    {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey", []),
306    {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey"),
307    LocalTime = calendar:universal_time_to_local_time({{2007, 5, 15}, {13, 45, 33}}),
308    C2 = {"Set-Cookie",
309          "Customer=WILE_E_COYOTE; "
310          "Version=1; "
311          "Expires=Tue, 15-May-2007 13:45:33 GMT; "
312          "Max-Age=0"},
313    C2 = cookie("Customer", "WILE_E_COYOTE",
314                [{max_age, -111}, {local_time, LocalTime}]),
315    C3 = {"Set-Cookie",
316          "Customer=WILE_E_COYOTE; "
317          "Version=1; "
318          "Expires=Wed, 16-May-2007 13:45:50 GMT; "
319          "Max-Age=86417"},
320    C3 = cookie("Customer", "WILE_E_COYOTE",
321                [{max_age, 86417}, {local_time, LocalTime}]),
322    ok.
323
324-endif.