Erlang Terms in Cookies

Erlang is an increasingly popular choice for web development. Such projects tend to heavily leverage HTTP cookies, and because Erlang defines an external format for any Erlang term, it turns out to be very easy to store an arbitrary term with a cookie (within cookie size limitations), which can be a useful trick.

The technique outlined here generates a signed but not encrypted cookie. That means it's fairly simple for anyone possessing one of your cookies to determine the contents, but difficult for them to forge a novel cookie. The latter is typically important for the application, but has additional importance here because we will be calling erlang:binary_to_term/1 on the cookie value and passing arbitrary data to erlang:binary_to_term/1 is a bad idea (for example, this could cause an extremely large memory allocation).

Here's the code:

-module (termcookie).
-export ([ decode/2,
      encode/2 ]).

%
% Public
%

decode (Encoded, Secret) when is_binary (Encoded) ->
<<Signature:28/binary, Payload/binary>> = Encoded,
Signature = to_base64 (crypto:sha ([ Payload, Secret ])),
erlang:binary_to_term (from_base64 (Payload)).

encode (Term, Secret) ->
Payload =
to_base64
 (erlang:term_to_binary (Term,
                         [ compressed,
                           { minor_version, 1 } ])),
Signature = to_base64 (crypto:sha ([ Payload, Secret ])),
<<Signature/binary, Payload/binary>>.

%
% Private
%

to_base64 (Bin) when (8 * byte_size (Bin)) rem 6 =:= 0 ->
to_base64_padded (Bin);
to_base64 (Bin) when (8 * byte_size (Bin)) rem 6 =:= 2 ->
to_base64_padded (<<Bin/binary, 0:16>>);
to_base64 (Bin) when (8 * byte_size (Bin)) rem 6 =:= 4 ->
to_base64_padded (<<Bin/binary, 0:8>>).

to_base64_padded (Bin) ->
<< <<(to_base64_char (N)):8>> || <<N:6>> <= Bin >>.

to_base64_char (N) when N >= 0, N =< 25 -> $a + N;
to_base64_char (N) when N >= 26, N =< 51 -> $A + (N - 26);
to_base64_char (N) when N >= 52, N =< 61 -> $0 + (N - 52);
to_base64_char (62) -> $.;
to_base64_char (63) -> $,.

from_base64 (Bin) ->
<< <<(from_base64_char (N)):6>> || <<N:8>> <= Bin >>.

from_base64_char (N) when N >= $a, N =< $z -> N - $a;
from_base64_char (N) when N >= $A, N =< $Z -> 26 + (N - $A);
from_base64_char (N) when N >= $0, N =< $9 -> 52 + (N - $0);
from_base64_char ($.) -> 62;
from_base64_char ($,) -> 63.

We are taking advantage of the fact that erlang:binary_to_term/1 will ignore extra bytes at the end, which allows us to mindlessly pad for base 64 encoding.

If you really like to squeeze the last few drops of efficiency out of code, you can change those to_base64_char/1 and from_base64_char/1 functions into tuple lookups. If you are extra cool you can use Ulf Wiger's ct_expand parse transform to construct the tuples at compile time from a specified character list.

This code will throw an exception if anything is amiss with the input, including a signature fail.

% erl
Erlang (BEAM) emulator version 5.6.5 [source] [async-threads:0] [kernel-poll:false]

Eshell V5.6.5  (abort with ^G)
1> crypto:start ().
ok
2> termcookie:encode ({ "omg", erlang, rulz }, "wazzup").
<<"nQCwmuMgeK3bTPzBqKDSmSylIciaG2GdAWadB21NzaagzxjSyw5NzaaeCNvSEGaa">>
3> termcookie:decode (termcookie:encode ({ "omg", erlang, rulz }, "wazzup"), "wazzup").
{"omg",erlang,rulz}
4> termcookie:decode (termcookie:encode ({ "omg", erlang, rulz }, "huh"), "wazzup").
** exception error: no match of right hand side value <<"nQCwmuMgeK3bTPzBqKDSmSylIcia">>
 in function  termcookie:decode/2

Implementing a DSL in Erlang

If you are willing to abide by Erlang syntax, then you can leverage erl_parse, erl_scan, and erl_eval to quickly whip up a domain specific language (DSL). You can manipulate the semantics via a combination of transformations on the parse tree (with the help of erl_syntax) and interception of function calls (which comes with erl_eval).

For instance, suppose we want a domain specific language which is just like Erlang, except that it has destructive assignment. This can be done in three steps: 1) parse the input using the Erlang parser, 2) transform the parse tree so that match expressions are rewritten as a special local function call, and 3) eval the result, intercept the special local function call and implement the destructive assignment by recursive eval.

Here's the code:

-module (dsl).
-export ([ compile/1,
           run/2 ]).

%-========================================================-
%-                   Public                               -
%-========================================================-

compile (String) ->
  { ok, Scanned, _ } = 
    erl_scan:string (maybe_append_dot (String)),
  { ok, Parsed } = erl_parse:parse_exprs (Scanned),
  { dsl, transform (Parsed) }.

run ({ dsl, Parsed }, Bindings) ->
  eval (Parsed, Bindings).

%-========================================================-
%-               eval callbacks                           -
%-========================================================-

local ('_assign', [ Pattern, Expr ], Bindings) ->
  { value, Rhs, NewBindings } = 
    eval ([ Expr ], Bindings),
  MatchExpr = 
    erl_syntax:match_expr (Pattern, 
                           erl_syntax:abstract (Rhs)),
  { value, _Lhs, MatchBindings } = 
    eval ([ erl_syntax:revert (MatchExpr) ],
            erl_eval:new_bindings ()),
  { value, 
    Rhs, 
    destructive_merge (NewBindings, MatchBindings) }.

%-========================================================-
%-                  Private                               -
%-========================================================-

destructive_merge (Bindings, MatchBindings) ->
  lists:foldl
    (fun ({ Key, Val }, Acc) ->
       erl_eval:add_binding 
        (Key, 
         Val, 
         erl_eval:del_binding (Key, Acc))
     end,
     Bindings,
     erl_eval:bindings (MatchBindings)).

eval (Parsed, Bindings) ->
  erl_eval:exprs (Parsed, 
                  Bindings, 
                  { eval, fun local/3 }).

maybe_append_dot (String) ->
  case lists:last (string:strip (String, 
                                 right)) of
    $. -> String;
    _ -> String ++ "."
  end.

postorder (F, Tree) ->
  F (case erl_syntax:subtrees (Tree) of
       [] -> 
         Tree;
       List -> 
         erl_syntax:update_tree 
           (Tree,
            [[ postorder (F, Subtree)
             || Subtree <- Group ]
            || Group <- List ])
     end).

transform (Parsed) ->
  F = fun (Node) ->
        case erl_syntax:type (Node) of
          % match_expr: rewrite as (destructive) assignment
          match_expr ->
            erl_syntax:application 
              (none,
               erl_syntax:atom ("_assign"),
               [ erl_syntax:match_expr_pattern (Node),
                 erl_syntax:match_expr_body (Node) ]);
          _ ->
            Node
        end
      end,

  [ erl_syntax:revert (postorder (F, X)) 
    || X <- Parsed ].

dsl:compile/1 scans and parses the string in the standard way, but transforms the resulting parse tree rewriting match expressions as calls to a fictitious local function _assign/2. This local function call is intercepted by specifying a local function handler to erl_eval:exprs/3. At that point (lines 22-33), the sequence is: 1) evaluate the right hand side using the current bindings to reduce the right hand side to a constant, 2) evaluate a match of the left hand side to the constant expression given an empty set of bindings, and 3) merge the new bindings with the existing bindings, overwriting as necessary. By proceeding in this fashion, we can still error out if we have a structural mismatch, or if an unbound variable is used on a right hand side.

% erl
Erlang (BEAM) emulator version 5.6.5 [source] [async-threads:0] [kernel-poll:false]

Eshell V5.6.5  (abort with ^G)
1> c (dsl).
{ok,dsl}
2> dsl:run (dsl:compile ("A = 7, A = A + 3"), erl_eval:new_bindings ()).
{value,10,[{'A',10}]}
3> dsl:run (dsl:compile ("B = 7, A = A + 3"), erl_eval:new_bindings ()).
** exception error: variable 'A' is unbound
4> dsl:run (dsl:compile ("A = 7, { _, A } = A + 3"), erl_eval:new_bindings ()).
** exception error: no match of right hand side value 10

Ets Ordered Set Select Efficiency

Ets (and tcerl) ordered_sets have the useful property that range queries on them can be resolved more efficiently than full-table scan. For instance, given the operation

ets:select (Tab, [ { { { foo, 1, '_' }, bar }, [], [ '$_' ] } ])

only the range of keys corresponding to 3-element tuples whose first two elements are 'foo' and 1 will be examined, and this is potentially far less than the entire set of keys.

Recently I've been working on a project that requires a range of partially bound keys. This would correspond to an operation such as

ets:select (Tab, [ { { { foo, '$1', '_' }, bar }, [ { '>=', '$1', 1 }, { '=<', '$1', 5 } ], [ '$_' ] } ]) 

and so I made the modifications to tcerl to be able to detect match conditions of this form and constrain the query range. I started to wonder if I was reinventing the wheel and whether ets had sophisticated match specification analysis under the hood somewhere. I asked the mailing list but answers were inconclusive so I decided to do some measurements. Using the following module:

-module (etsselect).
-compile (export_all).

populate_ets (Tab, N) ->
 ets:delete_all_objects (Tab),
 lists:foreach (fun (M) ->
                  ets:insert (Tab, { { foo, M div 10, M }, bar })
                end,
                lists:seq (1, N)).

repeat_factor (Size) when Size < 1000 -> 100;
repeat_factor (Size) when Size < 100000 -> 30;
repeat_factor (_) -> 10.

select (MatchSpec, Tab, Repeat) when Repeat > 0 ->
 ets:select (Tab, MatchSpec),
 select (MatchSpec, Tab, Repeat - 1);
select (_, _, _) ->
 ok.

select_time (MatchSpec) ->
 Tab = ets:new (?MODULE, [ ordered_set ]),
 try
   [ { N,
       (fun () ->
          populate_ets (Tab, N),
          { Time, _ } = timer:tc (?MODULE, select, [ MatchSpec, Tab, Repeat ]),
          Time / Repeat
        end) ()
     }
    || X <- lists:seq (1, 9),
       N <- [ trunc (math:pow (5, X)) ],
       Repeat <- [ repeat_factor (N) ]
   ]
 after   
   ets:delete (Tab)      
 end.  

I did some timing tests with different match specifications and table sizes. The match specifications were:

[{ '_', [], [ '$_' ] }] % unconstrained
[{{{ foo, 1, '_' }, bar }, [], [ '$_' ] }] % prefix bound
[{{{ foo, '$1', '_' }, bar }, 
   [{ '>=', '$1', 1 }, { '=<', '$1', 1 }],
   [ '$_' ]
 }] % prefix range bound

The results (using R12B5) indicate that the prefix range bound condition is not being optimized by ets.

The tcerl timings indicate the prefix range bound condition is being optimized (they also indicate much worse constant factors then ets).

Note I haven't released these changes yet, but I will soon as 1.3.1h. Versions of tcerl prior to 1.3.1h will do a full table scan in the prefix range bound case.