/src/mochiweb_cookies.erl

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