%%% see: http://www.sics.se/~joe/ubf/site/home.html
%%% Written by: Joe Armstrong
%%% Adapted for binary strings and data by Marc Worrell
%%% Copyright 2002-2003 Joe Armstrong.
%%% Copyright 2013 Marc Worrell.
%%%
%%% All rights reserved.
%%%
%%% Permission is hereby granted, free of charge, to any person obtaining
%%% a copy of this software and associated documentation files (the
%%% "Software"), to deal in the Software without restriction, including
%%% without limitation the rights to use, copy, modify, merge, publish,
%%% distribute, sublicense, and/or sell copies of the Software, and to
%%% permit persons to whom the Software is furnished to do so, subject to
%%% the following conditions:
%%%
%%% The above copyright notice and this permission notice shall be
%%% included in all copies or substantial portions of the Software.
%%%
%%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
%%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
%%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
%%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
%%% LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
%%% OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
%%% WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-module(z_ubf).
-export([decode_init/0, decode_init/1, decode/1, decode/2, encode/1, encode/2]).
-export([encode_print/1, deabstract/1]).
%% Maximum flat-size of the decoded terms.
%% Prevents attacks where a decode can consume all available memory.
-define(MAX_DECODE_SIZE, 10*1024*1024).
%% Decoding rules
%% {'#S', String} -> String
%% Int -> Int
%% [ ] -> List
%% {...} -> Tuple
%% decode_init() -> Cont
%% decode(Str, Cont) -> {more, Cont'} | {done, Term, Str}
%% encode(Str) -> Bytes
%% intro() -> single line terminated with \n
decode(S) ->
decode(S, ?MAX_DECODE_SIZE).
decode(S, {more, Fun}) ->
Fun(S);
decode(Str, MaxSize) when is_binary(Str), is_integer(MaxSize) ->
case catch decode(Str, decode_init(MaxSize)) of
{done, Term, Rest} -> {ok, Term, Rest};
{more, _} = More -> More;
{error, _} = Error -> Error;
{'EXIT', Error} -> {error, Error}
end.
decode_init() ->
decode_init(?MAX_DECODE_SIZE).
decode_init(MaxSize) ->
{more, fun(I) -> decode1(I, [[]], dict:new(), MaxSize) end}.
decode1(_S, _Stack, _D, MaxSize) when MaxSize < 0 ->
exit(size);
decode1(S, Stack, D, MaxSize) ->
decode(S, Stack, D, MaxSize).
decode(<<$',T/binary>>, Stack, Dict, MaxSize) ->
get_stuff(T, $', <<>>, Stack, Dict, MaxSize);
decode(<<$~,T/binary>>, [[Int|Stack]|S1], Dict, MaxSize) when is_integer(Int), Int >= 0 ->
collect_binary(Int, T, <<>>, [Stack|S1], Dict, MaxSize - Int + erts_debug:size(Int));
decode(<<$~,_/binary>>, _Stack, _Dict, _MaxSize) ->
exit(tilde);
decode(<<$%, T/binary>>, Stack, Dict, MaxSize) ->
get_stuff(T, $%, <<>>, Stack, Dict, MaxSize);
decode(<<$", T/binary>>, Stack, Dict, MaxSize) ->
get_stuff(T, $", <<>>, Stack, Dict, MaxSize);
decode(<<$`, T/binary>>, Stack, Dict, MaxSize) ->
get_stuff(T, $`, <<>>, Stack, Dict, MaxSize);
decode(<<$-, T/binary>>, Stack, Dict, MaxSize) ->
collect_int(T, 0, '-', Stack, Dict, MaxSize);
decode(<<H, T/binary>>, Stack, Dict, MaxSize) when $0 =< H, H =< $9 ->
collect_int(T, H-$0, '+', Stack, Dict, MaxSize);
decode(<<${, T/binary>>, Stack, Dict, MaxSize) ->
decode1(T, [[]|Stack], Dict, MaxSize);
decode(<<$}, T/binary>>, [H|Stack], Dict, MaxSize) ->
decode1(T, push(list_to_tuple(lists:reverse(H)),Stack), Dict, MaxSize);
decode(<<$&, T/binary>>, [ [H1,H2|T1] | Stack], Dict, MaxSize) ->
decode1(T, [[[H1|H2]|T1]|Stack], Dict, MaxSize);
decode(<<$#, T/binary>>, Stack, Dict, MaxSize) ->
decode1(T, push([], Stack), Dict, MaxSize);
decode(<<$$, T/binary>>, [[X]], _Dict, _MaxSize) ->
{done, X, T};
decode(<<$>,Key, T/binary>>, [[Val|R]|Stack], Dict, MaxSize) ->
decode1(T, [R|Stack], dict:store(Key,Val,Dict), MaxSize);
decode(<<H, T/binary>>, Stack, Dict, MaxSize) ->
case special(H) of
true ->
decode1(T, Stack, Dict, MaxSize);
false ->
Term = dict:fetch(H, Dict),
decode1(T, push(Term, Stack), Dict, MaxSize - erts_debug:flat_size(Term))
end;
decode(<<>>, Stack, Dict, MaxSize) ->
{more, fun(I) -> decode1(I, Stack, Dict, MaxSize) end};
decode(X, _Stack, _Dict, _MaxSize) ->
{error, {eof, X}}.
get_stuff(<<$\\,H,T/binary>>, Stop, L, Stack, Dict, MaxSize) ->
get_stuff(T, Stop, <<L/binary,H>>, Stack, Dict, MaxSize);
get_stuff(<<$',T/binary>>, $', L, Stack, Dict, MaxSize) ->
Atom = list_to_existing_atom(z_convert:to_list(L)),
decode1(T, push(Atom,Stack), Dict, MaxSize - erts_debug:flat_size(Atom));
get_stuff(<<$",T/binary>>, $", L, Stack, Dict, MaxSize) ->
decode1(T, push(L,Stack), Dict, MaxSize - erts_debug:flat_size(L));
get_stuff(<<$`,T/binary>>, $`, L, [[H|Tail]|Stack] = TS, Dict, MaxSize) ->
case L of
<<"plist">> ->
decode1(T, TS, Dict, MaxSize);
<<"map">> ->
% @todo: add conditional compilation for list to map
decode1(T, TS, Dict, MaxSize);
<<"f">> ->
F = erlang:binary_to_float(H),
decode1(T, [[F|Tail]|Stack], Dict, MaxSize - erts_debug:flat_size(F));
<<"dt">> ->
DT = timestamp_to_datetime(H),
decode1(T, [[DT|Tail]|Stack], Dict, MaxSize - erts_debug:flat_size(DT));
_ ->
decode1(T, TS, Dict, MaxSize)
end;
get_stuff(<<$%,T/binary>>, $%, _L, Stack, Dict, MaxSize) ->
decode1(T, Stack, Dict, MaxSize);
get_stuff(<<H,T/binary>>, Stop, L, Stack, Dict, MaxSize) ->
get_stuff(T, Stop, <<L/binary, H>>, Stack, Dict, MaxSize);
get_stuff(<<>>, Stop, L, Stack, Dict, MaxSize) ->
{more, fun(I) ->
get_stuff(I, Stop, L, Stack, Dict, MaxSize) end}.
collect_binary(0, T, L, Stack, Dict, MaxSize) ->
expect_tilde(T, push(L, Stack), Dict, MaxSize);
collect_binary(N, <<H,T/binary>>, L, Stack, Dict, MaxSize) ->
collect_binary(N-1, T, <<L/binary, H>>, Stack, Dict, MaxSize);
collect_binary(N, <<>>, L, Stack, Dict, MaxSize) ->
{more, fun(I) -> collect_binary(N, I, L, Stack, Dict, MaxSize) end}.
expect_tilde(<<$~, T/binary>>, Stack, Dict, MaxSize) ->
decode1(T, Stack, Dict, MaxSize);
expect_tilde(<<>>, Stack, Dict, MaxSize) ->
{more, fun(I) -> expect_tilde(I, Stack, Dict, MaxSize) end};
expect_tilde(<<H,_/binary>>, _Stack, _Dict, _MaxSize) ->
exit({expect_tilde, H}).
push(X, [Top|Rest]) ->
[[X|Top]|Rest];
push(X, Y) ->
exit({bad_push, X, Y}).
special($ ) -> true;
special(${) -> true;
special($}) -> true;
special($,) -> true;
special($#) -> true;
special($&) -> true;
special($%) -> true;
special($>) -> true;
special($\n) -> true;
special($\r) -> true;
special($\t) -> true;
special($$) -> true;
special($") -> true;
special($') -> true;
special($~) -> true;
special($`) -> true;
special(_) -> false.
special_chars() ->
" 0123456789{},~%#>\n\r\s\t\"'-&$`".
collect_int(<<H,T/binary>>, N, Sign, Stack, Dict, MaxSize) when $0 =< H, H =< $9 ->
collect_int(T, N*10 + H - $0, Sign, Stack, Dict, MaxSize);
collect_int(<<>>, N, Sign, Stack, Dict, MaxSize) ->
{more, fun(I) -> collect_int(I, N, Sign, Stack, Dict, MaxSize) end};
collect_int(T, N, '+', Stack, Dict, MaxSize) ->
decode1(T, push(N, Stack), Dict, MaxSize - erts_debug:size(N));
collect_int(T, N, '-', Stack, Dict, MaxSize) ->
decode1(T, push(-N, Stack), Dict, MaxSize - erts_debug:size(N)).
%%---------------------------------------------------------------------
encode_print(X) ->
io:format("~s~n",[encode(X)]).
encode(X) ->
encode(X, []).
encode(X, Options) when is_list(Options) ->
case encode(X, dict:new(), Options) of
{ok, Bin, _Dict} -> {ok, Bin};
{error, _} = Error -> Error
end;
encode(X, Dict) ->
encode(X, Dict, []).
encode(X, Dict0, Options) ->
{Dict1, L1} = initial_dict(X, Dict0),
case (catch do_encode(X, Dict1, Options)) of
{'EXIT', What} ->
{error, What};
L ->
{ok, iolist_to_binary([L1, L,$$]), Dict1}
end.
initial_dict(X, Dict0) ->
Free = lists:seq(32,255) -- special_chars(),
Most = analyse(X),
%% io:format("Analysis:~p~n",[Most]),
load_dict(Most, Free, Dict0, []).
load_dict([{N,X}|T], [Key|T1], Dict0, L) when N > 0->
load_dict(T, T1, dict:store(X, Key, Dict0),
[encode_obj(X),">",Key|L]);
load_dict(_, _, Dict, L) ->
{Dict, L}.
analyse(T) ->
KV = dict:to_list(analyse(T, dict:new())),
%% The Range is the Number of things times its size
%% If the size is greater than 0
KV1 = lists:map(fun rank/1, KV),
lists:reverse(lists:sort(KV1)).
rank({X, K}) when is_atom(X) ->
case length(atom_to_list(X)) of
N when N > 1, K > 1 ->
{(N-1) * K, X};
_ ->
{0, X}
end;
rank({X, K}) when is_integer(X) ->
case length(integer_to_list(X)) of
N when N > 1, K > 1 ->
{(N-1) * K, X};
_ ->
{0, X}
end;
rank({X, _}) ->
{0, X}.
analyse({'#S', Str}, Dict) ->
analyse(Str, Dict);
analyse(T, Dict) when is_tuple(T) ->
lists:foldl(fun analyse/2, Dict, tuple_to_list(T));
analyse(X, Dict) ->
case dict:find(X, Dict) of
{ok, Val} ->
dict:store(X, Val+1, Dict);
error ->
dict:store(X, 1, Dict)
end.
encode_obj(X) when is_atom(X) -> encode_atom(X);
encode_obj(X) when is_integer(X) -> integer_to_list(X);
encode_obj(X) when is_binary(X) -> encode_binary(X).
encode_string(S) -> [$",add_string(S, $"), $"].
encode_atom(X) -> [$',add_string(atom_to_list(X), $'), $'].
encode_binary(X) -> [integer_to_list(size(X)), $~,X,$~].
do_encode(X, Dict, _Options) when is_atom(X); is_integer(X); is_binary(X) ->
case dict:find(X, Dict) of
{ok, Y} ->
Y;
error ->
encode_obj(X)
end;
do_encode({'#S', Str}, _Dict, _Options) ->
%% This *is* a string
encode_string(Str);
do_encode({{Y,M,D},{H,I,S}} = DT, Dict, Options)
when is_integer(Y), is_integer(M), is_integer(D),
is_integer(H), is_integer(I), is_integer(S) ->
case datetime_to_timestamp(DT) of
undefined -> do_encode(undefined, Dict, Options);
Timestamp -> [integer_to_binary(Timestamp),"`dt`"]
end;
do_encode([_|_] = List, Dict, Options) ->
Enc = encode_list(List, Dict, [], Options),
case list_type(List, Options) of
plist -> [$#,Enc,"`plist`"];
list -> [$#,Enc]
end;
do_encode(T, Dict, Options) when is_tuple(T) ->
S1 = encode_tuple(1, T, Dict, Options),
[${,S1,$}];
do_encode(F, _Dict, _Options) when is_float(F) ->
[$",io_lib:format("~p", [F]),$","`f`"];
do_encode([], _Dict, _Options) ->
$#.
list_type(L, Options) ->
case lists:all(fun(E) -> is_proplist_elt(E, Options) end, L) and not lists:all(fun is_atom/1, L)
of
true -> plist;
false -> list
end.
is_proplist_elt({K,_}, Options) when is_binary(K); is_atom(K) ->
RecordNames = proplists:get_value(record_names, Options, []),
not lists:member(K, RecordNames);
is_proplist_elt(A, _Options) when is_atom(A) ->
true;
is_proplist_elt(_, _Options) ->
false.
encode_list([H|T], Dict, L, Options) ->
encode_list(T, Dict, [do_encode(H, Dict, Options),$&|L], Options);
encode_list([], _Dict, L, _Options) ->
L.
encode_tuple(N, T, _Dict, _Options) when N > size(T) ->
"";
encode_tuple(N, T, Dict, Options) ->
S1 = do_encode(element(N, T), Dict, Options),
S2 = encode_tuple(N+1, T, Dict, Options),
[S1,possible_comma(N, T),S2].
possible_comma(N, T) when N < size(T) -> $,;
possible_comma(_, _) -> [].
%% The ascii printables are in the range 32..126 includive
add_string([$\\|T], Quote) -> [$\\,$\\|add_string(T, Quote)];
add_string([Quote|T], Quote) -> [$\\,Quote|add_string(T, Quote)];
add_string([H|T], Quote) when H >= 0, H=< 255 -> [H|add_string(T, Quote)];
add_string([H|_], _Quote) -> exit({string_character,H});
add_string([], _) -> [].
deabstract({'#S',S}) -> S;
deabstract(T) when is_tuple(T) ->
list_to_tuple(lists:map(fun deabstract/1, tuple_to_list(T)));
deabstract([H|T]) -> [deabstract(H)|deabstract(T)];
deabstract(T) -> T.
-define(SECS_1970, 62167219200).
timestamp_to_datetime(Seconds) when is_integer(Seconds) ->
calendar:gregorian_seconds_to_datetime(?SECS_1970 + Seconds).
datetime_to_timestamp({{9999,_,_},{_,_,_}}) ->
undefined;
datetime_to_timestamp({{_,_,_},{_,_,_}} = DT) ->
calendar:datetime_to_gregorian_seconds(DT) - ?SECS_1970.
