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