/src/utils/ewgi_util_cookie.erl

  1%% @author Emad El-Haraty <emad@mochimedia.com>
  2%% @copyright 2007 Mochi Media, Inc.
  3%%
  4%% @author Hunter Morris <hunter.morris@smarkets.com>
  5%% @copyright 2009 Smarkets Limited.
  6%%
  7%% Licensed under the MIT license:
  8%% http://www.opensource.org/licenses/mit-license.php
  9
 10%% @doc HTTP Cookie parsing (RFC 2109, RFC 2965)
 11%% - parse_cookie/1 shamelessly ripped off mochiweb.
 12%% - simple_cookie/[3,4] moved off smak_auth_cookie.
 13
 14-module(ewgi_util_cookie).
 15-export([parse_cookie/1, test/0]).
 16-export([cookie_headers/5, cookie_safe_encode/1, cookie_safe_decode/1, get_domains/1]).
 17
 18-include("ewgi.hrl").
 19
 20-define(QUOTE, $\").
 21
 22-define(IS_WHITESPACE(C),
 23        (C =:= $\s orelse C =:= $\t orelse C =:= $\r orelse C =:= $\n)).
 24
 25%% RFC 2616 separators (called tspecials in RFC 2068)
 26-define(IS_SEPARATOR(C),
 27        (C < 32 orelse
 28         C =:= $\s orelse C =:= $\t orelse
 29         C =:= $( orelse C =:= $) orelse C =:= $< orelse C =:= $> orelse
 30         C =:= $@ orelse C =:= $, orelse C =:= $; orelse C =:= $: orelse
 31         C =:= $\\ orelse C =:= $\" orelse C =:= $/ orelse
 32         C =:= $[ orelse C =:= $] orelse C =:= $? orelse C =:= $= orelse
 33         C =:= ${ orelse C =:= $})).
 34
 35-define(COOKIE_DELETE_TRAILER, "; Expires=Thu, 01 Jan 1970 23:00:00 GMT; Max-Age=0").
 36
 37%% @spec parse_cookie(string()) -> [{K::string(), V::string()}]
 38%% @doc Parse the contents of a Cookie header field, ignoring cookie
 39%% attributes, and return a simple property list.
 40parse_cookie("") -> 
 41    [];
 42parse_cookie(Cookie) -> 
 43    parse_cookie(Cookie, []).
 44
 45%% @spec test() -> ok
 46%% @doc Run tests for mochiweb_cookies.
 47test() ->
 48    parse_cookie_test(),
 49    ok.
 50
 51%% Internal API
 52
 53parse_cookie([], Acc) ->
 54    lists:reverse(Acc); 
 55parse_cookie(String, Acc) -> 
 56    {{Token, Value}, Rest} = read_pair(String),
 57    Acc1 = case Token of
 58               "" ->
 59                   Acc;
 60               "$" ++ _ ->
 61                   Acc;
 62               _ ->
 63                   [{Token, Value} | Acc]
 64           end,
 65    parse_cookie(Rest, Acc1).
 66
 67read_pair(String) ->
 68    {Token, Rest} = read_token(skip_whitespace(String)),
 69    {Value, Rest1} = read_value(skip_whitespace(Rest)),
 70    {{Token, Value}, skip_past_separator(Rest1)}.
 71
 72read_value([$= | Value]) ->
 73    Value1 = skip_whitespace(Value),
 74    case Value1 of
 75        [?QUOTE | _] ->
 76            read_quoted(Value1);
 77        _ ->
 78            read_token(Value1)
 79    end;
 80read_value(String) ->
 81    {"", String}.
 82
 83read_quoted([?QUOTE | String]) ->
 84    read_quoted(String, []).
 85
 86read_quoted([], Acc) ->
 87    {lists:reverse(Acc), []};
 88read_quoted([?QUOTE | Rest], Acc) ->
 89    {lists:reverse(Acc), Rest};
 90read_quoted([$\\, Any | Rest], Acc) ->
 91    read_quoted(Rest, [Any | Acc]);
 92read_quoted([C | Rest], Acc) ->
 93    read_quoted(Rest, [C | Acc]).
 94    
 95skip_whitespace(String) ->
 96    F = fun (C) -> ?IS_WHITESPACE(C) end,
 97    lists:dropwhile(F, String).
 98
 99read_token(String) ->
100    F = fun (C) -> not ?IS_SEPARATOR(C) end,
101    lists:splitwith(F, String).
102
103skip_past_separator([]) ->    
104    [];
105skip_past_separator([$; | Rest]) ->
106    Rest;
107skip_past_separator([$, | Rest]) ->
108    Rest;
109skip_past_separator([_ | Rest]) ->
110    skip_past_separator(Rest).
111
112parse_cookie_test() ->
113    %% RFC example
114    C1 = "$Version=\"1\"; Customer=\"WILE_E_COYOTE\"; $Path=\"/acme\"; 
115    Part_Number=\"Rocket_Launcher_0001\"; $Path=\"/acme\";
116    Shipping=\"FedEx\"; $Path=\"/acme\"",
117    [
118     {"Customer","WILE_E_COYOTE"},
119     {"Part_Number","Rocket_Launcher_0001"},
120     {"Shipping","FedEx"}
121    ] = parse_cookie(C1),
122    %% Potential edge cases
123    [{"foo", "x"}] = parse_cookie("foo=\"\\x\""),
124    [] = parse_cookie("="),
125    [{"foo", ""}, {"bar", ""}] = parse_cookie("  foo ; bar  "),
126    [{"foo", ""}, {"bar", ""}] = parse_cookie("foo=;bar="),
127    [{"foo", "\";"}, {"bar", ""}] = parse_cookie("foo = \"\\\";\";bar "),
128    [{"foo", "\";bar"}] = parse_cookie("foo=\"\\\";bar").
129
130
131%%====================================================================
132%% Functions for setting the cookie headers in the ewgi_response()
133%%====================================================================
134cookie_headers(Ctx, CookieName, CookieVal, Path, Sec) ->
135    {CurDomain, WildDomain} = get_domains(Ctx),
136    SessionHeaders =
137	[simple_cookie(CookieName, CookieVal, Path, Sec),
138	 simple_cookie(CookieName, CookieVal, Path, Sec, CurDomain),
139	 simple_cookie(CookieName, CookieVal, Path, Sec, WildDomain)],
140    OldHeaders = ewgi_api:response_headers(Ctx),
141    Headers = SessionHeaders ++ remove_cookie_headers(CookieName, OldHeaders, []),
142    ewgi_api:response_headers(Headers, Ctx).
143
144-spec get_domains(ewgi_context()) -> {string(), string()}.
145get_domains(Ctx) ->
146    Cur = case ewgi_api:get_header_value("host", Ctx) of
147              undefined ->
148                  ewgi_api:server_name(Ctx);
149              H ->
150                  H
151          end,
152    Wild = [$.|Cur],
153    {Cur, Wild}.
154
155remove_cookie_headers(_, [], Acc) ->
156    Acc;
157remove_cookie_headers(CookieName, [{"Set-Cookie", [CookieName|_]}|R], Acc) ->
158    remove_cookie_headers(CookieName, R, Acc);
159remove_cookie_headers(CookieName, [H|R], Acc) ->
160    remove_cookie_headers(CookieName, R, [H|Acc]).
161
162-spec simple_cookie(string(), string() | binary(), string(), boolean()) -> {string(), iolist()}.
163simple_cookie(Name, Val, Path, Sec) when is_binary(Val) ->
164    simple_cookie(Name, binary_to_list(Val), Path, Sec);
165simple_cookie(Name, Val, Path, Sec) when is_list(Name), is_list(Val), is_list(Path) ->
166    S = if Sec -> "; Secure"; true -> [] end,
167    Exp = case Val of [] -> ?COOKIE_DELETE_TRAILER; _ -> [] end,
168    {"Set-Cookie", [Name, $=, Val, "; Path=", Path, S, Exp]}.
169
170-spec simple_cookie(string(), binary() | string(), boolean(), binary() | string(), string()) -> {string(), iolist()}.
171simple_cookie(Name, Val, Path, Sec, Domain) when is_binary(Val) ->
172    simple_cookie(Name, binary_to_list(Val), Path, Sec, Domain);
173simple_cookie(Name, Val, Path, Sec, Domain) when is_binary(Domain) ->
174    simple_cookie(Name, Val, Path, Sec, binary_to_list(Domain));
175simple_cookie(Name, Val, Path, Sec, Domain) ->
176    S = if Sec -> "; Secure"; true -> [] end,
177    Exp = case Val of [] -> ?COOKIE_DELETE_TRAILER; _ -> [] end,
178    {"Set-Cookie", io_lib:format("~s=~s; Path=~s; Domain=~s~s~s", [Name, Val, Path, Domain, S, Exp])}.
179
180
181-spec cookie_safe_encode(binary()) -> binary().
182cookie_safe_encode(Bin) when is_binary(Bin) ->
183    Enc = binary_to_list(base64:encode(Bin)),
184    list_to_binary(cookie_safe_encode1(Enc, [])).
185
186-spec cookie_safe_encode1(string(), string()) -> string().
187cookie_safe_encode1([], Acc) ->
188    lists:reverse(Acc);
189cookie_safe_encode1([$=|Rest], Acc) ->
190    cookie_safe_encode1(Rest, [$~|Acc]);
191cookie_safe_encode1([$/|Rest], Acc) ->
192    cookie_safe_encode1(Rest, [$_|Acc]);
193cookie_safe_encode1([C|Rest], Acc) ->
194    cookie_safe_encode1(Rest, [C|Acc]).
195
196-spec cookie_safe_decode(binary() | list()) -> binary().
197cookie_safe_decode(Bin) when is_binary(Bin) ->
198    cookie_safe_decode(binary_to_list(Bin));
199cookie_safe_decode(L) when is_list(L) ->
200    Dec = cookie_safe_decode1(L, []),
201    base64:decode(Dec).
202
203-spec cookie_safe_decode1(string(), list()) -> list().
204cookie_safe_decode1([], Acc) ->
205    lists:reverse(Acc);
206cookie_safe_decode1([$~|Rest], Acc) ->
207    cookie_safe_decode1(Rest, [$=|Acc]);
208cookie_safe_decode1([$_|Rest], Acc) ->
209    cookie_safe_decode1(Rest, [$/|Acc]);
210cookie_safe_decode1([C|Rest], Acc) ->
211    cookie_safe_decode1(Rest, [C|Acc]).