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
119
120%% Return a date in the form of: Wdy, DD-Mon-YYYY HH:MM:SS GMT
121%% See also: rfc2109: 10.1.2
122rfc2109_cookie_expires_date(LocalTime) ->
123    {{YYYY,MM,DD},{Hour,Min,Sec}} =
124        case calendar:local_time_to_universal_time_dst(LocalTime) of
125            [] ->
126                {Date, {Hour1, Min1, Sec1}} = LocalTime,
127                LocalTime2 = {Date, {Hour1 + 1, Min1, Sec1}},
128                case calendar:local_time_to_universal_time_dst(LocalTime2) of
129                    [Gmt]   -> Gmt;
130                    [_,Gmt] -> Gmt
131                end;
132            [Gmt]   -> Gmt;
133            [_,Gmt] -> Gmt
134        end,
135    DayNumber = calendar:day_of_the_week({YYYY,MM,DD}),
136    lists:flatten(
137      io_lib:format("~s, ~2.2.0w-~3.s-~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
138                    [httpd_util:day(DayNumber),DD,httpd_util:month(MM),YYYY,Hour,Min,Sec])).
139
140add_seconds(Secs, LocalTime) ->
141    Greg = calendar:datetime_to_gregorian_seconds(LocalTime),
142    calendar:gregorian_seconds_to_datetime(Greg + Secs).
143
144age_to_cookie_date(Age, LocalTime) ->
145    rfc2109_cookie_expires_date(add_seconds(Age, LocalTime)).
146
147%% @spec parse_cookie(string()) -> [{K::string(), V::string()}]
148%% @doc Parse the contents of a Cookie header field, ignoring cookie
149%% attributes, and return a simple property list.
150parse_cookie("") ->
151    [];
152parse_cookie(Cookie) ->
153    parse_cookie(Cookie, []).
154
155%% Internal API
156
157parse_cookie([], Acc) ->
158    lists:reverse(Acc);
159parse_cookie(String, Acc) ->
160    {{Token, Value}, Rest} = read_pair(String),
161    Acc1 = case Token of
162               "" ->
163                   Acc;
164               "$" ++ _ ->
165                   Acc;
166               _ ->
167                   [{Token, Value} | Acc]
168           end,
169    parse_cookie(Rest, Acc1).
170
171read_pair(String) ->
172    {Token, Rest} = read_token(skip_whitespace(String)),
173    {Value, Rest1} = read_value(skip_whitespace(Rest)),
174    {{Token, Value}, skip_past_separator(Rest1)}.
175
176read_value([$= | Value]) ->
177    Value1 = skip_whitespace(Value),
178    case Value1 of
179        [?QUOTE | _] ->
180            read_quoted(Value1);
181        _ ->
182            read_token(Value1)
183    end;
184read_value(String) ->
185    {"", String}.
186
187read_quoted([?QUOTE | String]) ->
188    read_quoted(String, []).
189
190read_quoted([], Acc) ->
191    {lists:reverse(Acc), []};
192read_quoted([?QUOTE | Rest], Acc) ->
193    {lists:reverse(Acc), Rest};
194read_quoted([$\\, Any | Rest], Acc) ->
195    read_quoted(Rest, [Any | Acc]);
196read_quoted([C | Rest], Acc) ->
197    read_quoted(Rest, [C | Acc]).
198
199skip_whitespace(String) ->
200    F = fun (C) -> ?IS_WHITESPACE(C) end,
201    lists:dropwhile(F, String).
202
203read_token(String) ->
204    F = fun (C) -> not ?IS_SEPARATOR(C) end,
205    lists:splitwith(F, String).
206
207skip_past_separator([]) ->
208    [];
209skip_past_separator([$; | Rest]) ->
210    Rest;
211skip_past_separator([$, | Rest]) ->
212    Rest;
213skip_past_separator([_ | Rest]) ->
214    skip_past_separator(Rest).
215
216any_to_list(V) when is_list(V) ->
217    V;
218any_to_list(V) when is_atom(V) ->
219    atom_to_list(V);
220any_to_list(V) when is_binary(V) ->
221    binary_to_list(V);
222any_to_list(V) when is_integer(V) ->
223    integer_to_list(V).
224
225%%
226%% Tests
227%%
228-ifdef(TEST).
229-include_lib("eunit/include/eunit.hrl").
230
231quote_test() ->
232    %% ?assertError eunit macro is not compatible with coverage module
233    try quote(":wq")
234    catch error:{cookie_quoting_required, ":wq"} -> ok
235    end,
236    ?assertEqual(
237       "foo",
238       quote(foo)),
239    ok.
240
241parse_cookie_test() ->
242    %% RFC example
243    C1 = "$Version=\"1\"; Customer=\"WILE_E_COYOTE\"; $Path=\"/acme\";
244    Part_Number=\"Rocket_Launcher_0001\"; $Path=\"/acme\";
245    Shipping=\"FedEx\"; $Path=\"/acme\"",
246    ?assertEqual(
247       [{"Customer","WILE_E_COYOTE"},
248        {"Part_Number","Rocket_Launcher_0001"},
249        {"Shipping","FedEx"}],
250       parse_cookie(C1)),
251    %% Potential edge cases
252    ?assertEqual(
253       [{"foo", "x"}],
254       parse_cookie("foo=\"\\x\"")),
255    ?assertEqual(
256       [],
257       parse_cookie("=")),
258    ?assertEqual(
259       [{"foo", ""}, {"bar", ""}],
260       parse_cookie("  foo ; bar  ")),
261    ?assertEqual(
262       [{"foo", ""}, {"bar", ""}],
263       parse_cookie("foo=;bar=")),
264    ?assertEqual(
265       [{"foo", "\";"}, {"bar", ""}],
266       parse_cookie("foo = \"\\\";\";bar ")),
267    ?assertEqual(
268       [{"foo", "\";bar"}],
269       parse_cookie("foo=\"\\\";bar")),
270    ?assertEqual(
271       [],
272       parse_cookie([])),
273    ?assertEqual(
274       [{"foo", "bar"}, {"baz", "wibble"}],
275       parse_cookie("foo=bar , baz=wibble ")),
276    ok.
277
278domain_test() ->
279    ?assertEqual(
280       {"Set-Cookie",
281        "Customer=WILE_E_COYOTE; "
282        "Version=1; "
283        "Domain=acme.com; "
284        "HttpOnly"},
285       cookie("Customer", "WILE_E_COYOTE",
286              [{http_only, true}, {domain, "acme.com"}])),
287    ok.
288
289local_time_test() ->
290    {"Set-Cookie", S} = cookie("Customer", "WILE_E_COYOTE",
291                               [{max_age, 111}, {secure, true}]),
292    ?assertMatch(
293       ["Customer=WILE_E_COYOTE",
294        " Version=1",
295        " Expires=" ++ _,
296        " Max-Age=111",
297        " Secure"],
298       string:tokens(S, ";")),
299    ok.
300
301cookie_test() ->
302    C1 = {"Set-Cookie",
303          "Customer=WILE_E_COYOTE; "
304          "Version=1; "
305          "Path=/acme"},
306    C1 = cookie("Customer", "WILE_E_COYOTE", [{path, "/acme"}]),
307    C1 = cookie("Customer", "WILE_E_COYOTE",
308                [{path, "/acme"}, {badoption, "negatory"}]),
309    C1 = cookie('Customer', 'WILE_E_COYOTE', [{path, '/acme'}]),
310    C1 = cookie(<<"Customer">>, <<"WILE_E_COYOTE">>, [{path, <<"/acme">>}]),
311
312    {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey", []),
313    {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey"),
314    LocalTime = calendar:universal_time_to_local_time({{2007, 5, 15}, {13, 45, 33}}),
315    C2 = {"Set-Cookie",
316          "Customer=WILE_E_COYOTE; "
317          "Version=1; "
318          "Expires=Tue, 15-May-2007 13:45:33 GMT; "
319          "Max-Age=0"},
320    C2 = cookie("Customer", "WILE_E_COYOTE",
321                [{max_age, -111}, {local_time, LocalTime}]),
322    C3 = {"Set-Cookie",
323          "Customer=WILE_E_COYOTE; "
324          "Version=1; "
325          "Expires=Wed, 16-May-2007 13:45:50 GMT; "
326          "Max-Age=86417"},
327    C3 = cookie("Customer", "WILE_E_COYOTE",
328                [{max_age, 86417}, {local_time, LocalTime}]),
329    ok.
330
331-endif.
332